[flang-commits] [flang] 09ea692 - [flang] IEEE_ARITHMETIC intrinsic module procedures
V Donaldson via flang-commits
flang-commits at lists.llvm.org
Thu Jun 29 16:46:43 PDT 2023
Author: V Donaldson
Date: 2023-06-29T16:46:22-07:00
New Revision: 09ea692d166af42cda43bd24d42a6c67a12cce5a
URL: https://github.com/llvm/llvm-project/commit/09ea692d166af42cda43bd24d42a6c67a12cce5a
DIFF: https://github.com/llvm/llvm-project/commit/09ea692d166af42cda43bd24d42a6c67a12cce5a.diff
LOG: [flang] IEEE_ARITHMETIC intrinsic module procedures
Implement
- IEEE_CLASS
- IEEE_COPY_SIGN
- IEEE_GET_ROUNDING_MODE
- IEEE_IS_FINITE
- IEEE_IS_NAN
- IEEE_IS_NEGATIVE
- IEEE_IS_NORMAL
- IEEE_SET_ROUNDING_MODE
- IEEE_SIGNBIT
- IEEE_SUPPORT_ROUNDING
- IEEE_UNORDERED
- IEEE_VALUE
for all REAL kinds (2, 3, 4, 8, 10, 16) where applicable.
Added:
flang/include/flang/Runtime/ieee_arithmetic.h
flang/test/Lower/Intrinsics/ieee_class.f90
flang/test/Lower/Intrinsics/ieee_class_queries.f90
flang/test/Lower/Intrinsics/ieee_copy_sign.f90
flang/test/Lower/Intrinsics/ieee_rounding.f90
flang/test/Lower/Intrinsics/ieee_signbit.f90
flang/test/Lower/Intrinsics/ieee_unordered.f90
Modified:
flang/include/flang/Lower/PFTBuilder.h
flang/include/flang/Optimizer/Builder/IntrinsicCall.h
flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
flang/lib/Evaluate/fold-logical.cpp
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/PFTBuilder.cpp
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp
flang/module/ieee_arithmetic.f90
flang/test/Lower/Intrinsics/ieee_is_finite.f90
flang/test/Lower/Intrinsics/ieee_operator_eq.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 30d7da763344e8..5927fc1915ae34 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -706,6 +706,7 @@ struct FunctionLikeUnit : public ProgramUnit {
/// Primary result for function subprograms with alternate entries. This
/// is one of the largest result values, not necessarily the first one.
const semantics::Symbol *primaryResult{nullptr};
+ bool mayModifyRoundingMode{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 17abfef92fd261..b4b82eae6c50cf 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -231,11 +231,20 @@ struct IntrinsicLibrary {
mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genFindloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ mlir::Value genIeeeClass(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ void genIeeeGetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ mlir::Value genIeeeIsNan(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ mlir::Value genIeeeIsNegative(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIeeeIsNormal(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ void genIeeeSetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
+ mlir::Value genIeeeSignbit(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ mlir::Value genIeeeSupportRounding(mlir::Type, llvm::ArrayRef<mlir::Value>);
template <mlir::arith::CmpIPredicate pred>
- fir::ExtendedValue genIeeeTypeCompare(mlir::Type,
- llvm::ArrayRef<fir::ExtendedValue>);
+ mlir::Value genIeeeTypeCompare(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ mlir::Value genIeeeUnordered(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ mlir::Value genIeeeValue(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -244,7 +253,6 @@ struct IntrinsicLibrary {
llvm::ArrayRef<fir::ExtendedValue>);
template <Fortran::runtime::io::Iostat value>
mlir::Value genIsIostatValue(mlir::Type, llvm::ArrayRef<mlir::Value>);
- mlir::Value genIsNan(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIsFPClass(mlir::Type, llvm::ArrayRef<mlir::Value>,
int fpclass);
mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
index d59325b7218ece..a6dcfe6fa9564b 100644
--- a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
@@ -36,6 +36,12 @@ mlir::func::FuncOp getLlvmMemset(FirOpBuilder &builder);
/// Get the C standard library `realloc` function.
mlir::func::FuncOp getRealloc(FirOpBuilder &builder);
+/// Get the `llvm.get.rounding` intrinsic.
+mlir::func::FuncOp getLlvmGetRounding(FirOpBuilder &builder);
+
+/// Get the `llvm.set.rounding` intrinsic.
+mlir::func::FuncOp getLlvmSetRounding(FirOpBuilder &builder);
+
/// Get the `llvm.stacksave` intrinsic.
mlir::func::FuncOp getLlvmStackSave(FirOpBuilder &builder);
diff --git a/flang/include/flang/Runtime/ieee_arithmetic.h b/flang/include/flang/Runtime/ieee_arithmetic.h
new file mode 100644
index 00000000000000..7a264fd2232220
--- /dev/null
+++ b/flang/include/flang/Runtime/ieee_arithmetic.h
@@ -0,0 +1,47 @@
+#if 0 /*===-- include/flang/Runtime/ieee_arithmetic.h -------------------===*/
+/*
+ * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+ * See https://llvm.org/LICENSE.txt for license information.
+ * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+ *
+ *===----------------------------------------------------------------------===*/
+#endif
+#if 0
+This header can be included into both Fortran and C/C++.
+
+Fortran 2018 Clause 17.2 Fortran intrinsic module ieee_exceptions values.
+#endif
+
+#ifndef FORTRAN_RUNTIME_IEEE_ARITHMETIC_H_
+#define FORTRAN_RUNTIME_IEEE_ARITHMETIC_H_
+
+#if 0
+ieee_class_type values
+The sequence is that of f18 clause 17.2p3, but nothing depends on that.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_SIGNALING_NAN 1
+#define _FORTRAN_RUNTIME_IEEE_QUIET_NAN 2
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_INF 3
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL 4
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL 5
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO 6
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO 7
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL 8
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL 9
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_INF 10
+#define _FORTRAN_RUNTIME_IEEE_OTHER_VALUE 11
+
+#if 0
+ieee_round_type values
+The values are those of the llvm.get.rounding instrinsic, which is assumed by
+intrinsic module procedures ieee_get_rounding_mode, ieee_set_rounding_mode,
+and ieee_support_rounding.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_TO_ZERO 0
+#define _FORTRAN_RUNTIME_IEEE_NEAREST 1
+#define _FORTRAN_RUNTIME_IEEE_UP 2
+#define _FORTRAN_RUNTIME_IEEE_DOWN 3
+#define _FORTRAN_RUNTIME_IEEE_AWAY 4
+#define _FORTRAN_RUNTIME_IEEE_OTHER 5
+
+#endif
diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index 22df42c4d37ca3..e90090577b6ed1 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -167,10 +167,13 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
} else if (name == "__builtin_ieee_is_negative") {
auto restorer{context.messages().DiscardMessages()};
using DefaultReal = Type<TypeCategory::Real, 4>;
- return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
- ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
- return Scalar<T>{x.IsNegative()};
- }));
+ if (args[0] && args[0]->UnwrapExpr() &&
+ IsActuallyConstant(*args[0]->UnwrapExpr())) {
+ return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
+ ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
+ return Scalar<T>{x.IsNegative()};
+ }));
+ }
} else if (name == "__builtin_ieee_is_normal") {
auto restorer{context.messages().DiscardMessages()};
using DefaultReal = Type<TypeCategory::Real, 4>;
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 211d49659699e1..087d32032278c3 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3958,6 +3958,19 @@ class FirConverter : public Fortran::lower::AbstractConverter {
assert(blockId == 0 && "invalid blockId");
assert(activeConstructStack.empty() && "invalid construct stack state");
+ // Get the rounding mode at function entry, and arrange for it to be
+ // restored at all function exits.
+ if (!funit.isMainProgram() && funit.mayModifyRoundingMode) {
+ mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(*builder);
+ mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(*builder);
+ mlir::Value roundMode =
+ builder->create<fir::CallOp>(toLocation(), getRound).getResult(0);
+ mlir::Location endLoc =
+ toLocation(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
+ bridge.fctCtx().attachCleanup(
+ [=]() { builder->create<fir::CallOp>(endLoc, setRound, roundMode); });
+ }
+
mapDummiesAndResults(funit, callee);
// Map host associated symbols from parent procedure if any.
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 1530e9ed1d51bf..97afdaf49b672a 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -105,6 +105,13 @@ class PFTBuilder {
} else if constexpr (std::is_same_v<T, parser::ActionStmt>) {
return std::visit(
common::visitors{
+ [&](const common::Indirection<parser::CallStmt> &x) {
+ addEvaluation(lower::pft::Evaluation{
+ removeIndirection(x), pftParentStack.back(),
+ stmt.position, stmt.label});
+ checkForRoundingModeCall(x.value());
+ return true;
+ },
[&](const common::Indirection<parser::IfStmt> &x) {
convertIfStmt(x.value(), stmt.position, stmt.label);
return false;
@@ -122,6 +129,24 @@ class PFTBuilder {
return true;
}
+ /// Check for a call statement that could modify the fp rounding mode.
+ void checkForRoundingModeCall(const parser::CallStmt &callStmt) {
+ const auto &pd = std::get<parser::ProcedureDesignator>(callStmt.call.t);
+ const auto *callName = std::get_if<parser::Name>(&pd.u);
+ if (!callName)
+ return;
+ const Fortran::semantics::Symbol &procSym = callName->symbol->GetUltimate();
+ llvm::StringRef procName = toStringRef(procSym.name());
+ if (!procName.startswith("ieee_set_"))
+ return;
+ if (procName == "ieee_set_rounding_mode_0" ||
+ procName == "ieee_set_modes_0" || procName == "ieee_set_status_0")
+ evaluationListStack.back()
+ ->back()
+ .getOwningProcedure()
+ ->mayModifyRoundingMode = true;
+ }
+
/// Convert an IfStmt into an IfConstruct, retaining the IfStmt as the
/// first statement of the construct.
void convertIfStmt(const parser::IfStmt &ifStmt, parser::CharBlock position,
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 2f3722db85af8d..f5df115431a5fa 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -38,6 +38,7 @@
#include "flang/Optimizer/Support/FatalError.h"
#include "flang/Optimizer/Support/Utils.h"
#include "flang/Runtime/entry-names.h"
+#include "flang/Runtime/ieee_arithmetic.h"
#include "flang/Runtime/iostat.h"
#include "mlir/Dialect/Complex/IR/Complex.h"
#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
@@ -269,13 +270,30 @@ static constexpr IntrinsicHandler handlers[]{
{"ibits", &I::genIbits},
{"ibset", &I::genIbset},
{"ichar", &I::genIchar},
+ {"ieee_class", &I::genIeeeClass},
{"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
{"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
+ {"ieee_copy_sign", &I::genIeeeCopySign},
+ {"ieee_get_rounding_mode",
+ &I::genIeeeGetRoundingMode,
+ {{{"round_value", asAddr, handleDynamicOptional},
+ {"radix", asValue, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"ieee_is_finite", &I::genIeeeIsFinite},
- {"ieee_is_nan", &I::genIsNan},
+ {"ieee_is_nan", &I::genIeeeIsNan},
+ {"ieee_is_negative", &I::genIeeeIsNegative},
{"ieee_is_normal", &I::genIeeeIsNormal},
{"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
{"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
+ {"ieee_set_rounding_mode",
+ &I::genIeeeSetRoundingMode,
+ {{{"round_value", asValue, handleDynamicOptional},
+ {"radix", asValue, handleDynamicOptional}}},
+ /*isElemental=*/false},
+ {"ieee_signbit", &I::genIeeeSignbit},
+ {"ieee_support_rounding", &I::genIeeeSupportRounding},
+ {"ieee_unordered", &I::genIeeeUnordered},
+ {"ieee_value", &I::genIeeeValue},
{"ieor", &I::genIeor},
{"index",
&I::genIndex,
@@ -298,7 +316,7 @@ static constexpr IntrinsicHandler handlers[]{
{"is_iostat_eor", &I::genIsIostatValue<Fortran::runtime::io::IostatEor>},
{"ishft", &I::genIshft},
{"ishftc", &I::genIshftc},
- {"isnan", &I::genIsNan},
+ {"isnan", &I::genIeeeIsNan},
{"lbound",
&I::genLbound,
{{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
@@ -3199,72 +3217,648 @@ IntrinsicLibrary::genIchar(mlir::Type resultType,
return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
}
+// Return a reference to the contents of a derived type with one field.
+// Also return the field type.
+static std::pair<mlir::Value, mlir::Type>
+getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec) {
+ auto recType =
+ fir::unwrapPassByRefType(rec.getType()).dyn_cast<fir::RecordType>();
+ assert(recType.getTypeList().size() == 1 && "expected exactly one component");
+ auto [fieldName, fieldTy] = recType.getTypeList().front();
+ mlir::Value field = builder.create<fir::FieldIndexOp>(
+ loc, fir::FieldType::get(recType.getContext()), fieldName, recType,
+ fir::getTypeParams(rec));
+ return {builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldTy),
+ rec, field),
+ fieldTy};
+}
+
// IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)
// IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)
template <mlir::arith::CmpIPredicate pred>
-fir::ExtendedValue
+mlir::Value
IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
- llvm::ArrayRef<fir::ExtendedValue> args) {
+ llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 2);
- mlir::Value arg0 = fir::getBase(args[0]);
- mlir::Value arg1 = fir::getBase(args[1]);
- auto recType =
- fir::unwrapPassByRefType(arg0.getType()).dyn_cast<fir::RecordType>();
- assert(recType.getTypeList().size() == 1 && "expected exactly one component");
- auto [fieldName, fieldType] = recType.getTypeList().front();
- mlir::Type fieldIndexType = fir::FieldType::get(recType.getContext());
- mlir::Value field = builder.create<fir::FieldIndexOp>(
- loc, fieldIndexType, fieldName, recType, fir::getTypeParams(arg0));
- mlir::Value left = builder.create<fir::LoadOp>(
- loc, fieldType,
- builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
- arg0, field));
- mlir::Value right = builder.create<fir::LoadOp>(
- loc, fieldType,
- builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
- arg1, field));
+ auto [leftRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
+ auto [rightRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[1]));
+ mlir::Value left = builder.create<fir::LoadOp>(loc, fieldTy, leftRef);
+ mlir::Value right = builder.create<fir::LoadOp>(loc, fieldTy, rightRef);
return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right);
}
+// IEEE_CLASS
+mlir::Value IntrinsicLibrary::genIeeeClass(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Classify REAL argument X as one of 11 IEEE_CLASS_TYPE values via
+ // a table lookup on an index built from 5 values derived from X.
+ // In indexing order, the values are:
+ //
+ // [s] sign bit
+ // [e] exponent != 0
+ // [m] exponent == 1..1 (max exponent)
+ // [l] low-order significand != 0
+ // [h] high-order significand (kind=10: 2 bits; other kinds: 1 bit)
+ //
+ // kind=10 values have an explicit high-order integer significand bit,
+ // whereas this bit is implicit for other kinds. This requires using a 6-bit
+ // index into a 64-slot table for kind=10 argument classification queries
+ // vs. a 5-bit index into a 32-slot table for other argument kind queries.
+ // The instruction sequence is the same for the two cases.
+ //
+ // Placing the [l] and [h] significand bits in "swapped" order rather than
+ // "natural" order enables more efficient generated code.
+
+ assert(args.size() == 1);
+ mlir::Value realVal = fir::getBase(args[0]);
+ mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
+ mlir::Type intType = builder.getIntegerType(realType.getWidth());
+ mlir::Value intVal =
+ builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
+ llvm::StringRef tableName = RTNAME_STRING(IeeeClassTable);
+ uint64_t highSignificandSize = (realType.getWidth() == 80) + 1;
+
+ // Get masks and shift counts.
+ mlir::Value signShift, highSignificandShift, exponentMask, lowSignificandMask;
+ auto createIntegerConstant = [&](uint64_t k) {
+ return builder.createIntegerConstant(loc, intType, k);
+ };
+ auto getMasksAndShifts = [&](uint64_t totalSize, uint64_t exponentSize,
+ uint64_t significandSize,
+ bool hasExplicitBit = false) {
+ assert(1 + exponentSize + significandSize == totalSize &&
+ "invalid floating point fields");
+ constexpr uint64_t one = 1; // type promotion
+ uint64_t lowSignificandSize = significandSize - hasExplicitBit - 1;
+ signShift = createIntegerConstant(totalSize - 1 - hasExplicitBit - 4);
+ highSignificandShift = createIntegerConstant(lowSignificandSize);
+ if (totalSize <= 64) {
+ exponentMask =
+ createIntegerConstant(((one << exponentSize) - 1) << significandSize);
+ lowSignificandMask =
+ createIntegerConstant((one << lowSignificandSize) - 1);
+ return;
+ }
+ // Mlir can't directly build large constants. Build them in steps.
+ // The folded end result is the same.
+ mlir::Value sixtyfour = createIntegerConstant(64);
+ exponentMask = createIntegerConstant(((one << exponentSize) - 1)
+ << (significandSize - 64));
+ exponentMask =
+ builder.create<mlir::arith::ShLIOp>(loc, exponentMask, sixtyfour);
+ if (lowSignificandSize <= 64) {
+ lowSignificandMask =
+ createIntegerConstant((one << lowSignificandSize) - 1);
+ return;
+ }
+ mlir::Value ones = createIntegerConstant(0xffffffffffffffff);
+ lowSignificandMask =
+ createIntegerConstant((one << (lowSignificandSize - 64)) - 1);
+ lowSignificandMask =
+ builder.create<mlir::arith::ShLIOp>(loc, lowSignificandMask, sixtyfour);
+ lowSignificandMask =
+ builder.create<mlir::arith::OrIOp>(loc, lowSignificandMask, ones);
+ };
+ switch (realType.getWidth()) {
+ case 16:
+ if (realType.isF16()) {
+ // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
+ getMasksAndShifts(16, 5, 10);
+ } else {
+ // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
+ getMasksAndShifts(16, 8, 7);
+ }
+ break;
+ case 32: // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
+ getMasksAndShifts(32, 8, 23);
+ break;
+ case 64: // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
+ getMasksAndShifts(64, 11, 52);
+ break;
+ case 80: // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
+ getMasksAndShifts(80, 15, 64, /*hasExplicitBit=*/true);
+ tableName = RTNAME_STRING(IeeeClassTable_10);
+ break;
+ case 128: // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
+ getMasksAndShifts(128, 15, 112);
+ break;
+ default:
+ llvm_unreachable("unknown real type");
+ }
+
+ // [s] sign bit
+ int pos = 3 + highSignificandSize;
+ mlir::Value index = builder.create<mlir::arith::AndIOp>(
+ loc, builder.create<mlir::arith::ShRUIOp>(loc, intVal, signShift),
+ createIntegerConstant(1 << pos));
+
+ // [e] exponent != 0
+ mlir::Value exponent =
+ builder.create<mlir::arith::AndIOp>(loc, intVal, exponentMask);
+ mlir::Value zero = createIntegerConstant(0);
+ index = builder.create<mlir::arith::OrIOp>(
+ loc, index,
+ builder.create<mlir::arith::SelectOp>(
+ loc,
+ builder.create<mlir::arith::CmpIOp>(
+ loc, mlir::arith::CmpIPredicate::ne, exponent, zero),
+ createIntegerConstant(1 << --pos), zero));
+
+ // [m] exponent == 1..1 (max exponent)
+ index = builder.create<mlir::arith::OrIOp>(
+ loc, index,
+ builder.create<mlir::arith::SelectOp>(
+ loc,
+ builder.create<mlir::arith::CmpIOp>(
+ loc, mlir::arith::CmpIPredicate::eq, exponent, exponentMask),
+ createIntegerConstant(1 << --pos), zero));
+
+ // [l] low-order significand != 0
+ index = builder.create<mlir::arith::OrIOp>(
+ loc, index,
+ builder.create<mlir::arith::SelectOp>(
+ loc,
+ builder.create<mlir::arith::CmpIOp>(
+ loc, mlir::arith::CmpIPredicate::ne,
+ builder.create<mlir::arith::AndIOp>(loc, intVal,
+ lowSignificandMask),
+ zero),
+ createIntegerConstant(1 << --pos), zero));
+
+ // [h] high-order significand (1 or 2 bits)
+ index = builder.create<mlir::arith::OrIOp>(
+ loc, index,
+ builder.create<mlir::arith::AndIOp>(
+ loc,
+ builder.create<mlir::arith::ShRUIOp>(loc, intVal,
+ highSignificandShift),
+ createIntegerConstant((1 << highSignificandSize) - 1)));
+
+ int tableSize = 1 << (4 + highSignificandSize);
+ mlir::Type int8Ty = builder.getIntegerType(8);
+ mlir::Type tableTy = fir::SequenceType::get(tableSize, int8Ty);
+ if (!builder.getNamedGlobal(tableName)) {
+ llvm::SmallVector<mlir::Attribute, 64> values;
+ auto insert = [&](std::int8_t which) {
+ values.push_back(builder.getIntegerAttr(int8Ty, which));
+ };
+ // If indexing value [e] is 0, value [m] can't be 1. (If the exponent is 0,
+ // it can't be the max exponent). Use IEEE_OTHER_VALUE for impossible
+ // combinations.
+ constexpr std::int8_t impossible = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;
+ if (tableSize == 32) {
+ // s e m l h kinds 2,3,4,8,16
+ // ===================================================================
+ /* 0 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);
+ /* 0 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 1 0 0 */ insert(impossible);
+ /* 0 0 1 0 1 */ insert(impossible);
+ /* 0 0 1 1 0 */ insert(impossible);
+ /* 0 0 1 1 1 */ insert(impossible);
+ /* 0 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+ /* 0 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+ /* 0 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+ /* 0 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+ /* 0 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);
+ /* 0 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+ /* 0 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
+ /* 0 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+ /* 1 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);
+ /* 1 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 1 0 0 */ insert(impossible);
+ /* 1 0 1 0 1 */ insert(impossible);
+ /* 1 0 1 1 0 */ insert(impossible);
+ /* 1 0 1 1 1 */ insert(impossible);
+ /* 1 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+ /* 1 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+ /* 1 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+ /* 1 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+ /* 1 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);
+ /* 1 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+ /* 1 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
+ /* 1 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+ } else {
+ // Unlike values of other kinds, kind=10 values can be "invalid", and
+ // can appear in code. Use IEEE_OTHER_VALUE for invalid bit patterns.
+ // Runtime IO may print an invalid value as a NaN.
+ constexpr std::int8_t invalid = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;
+ // s e m l h kind 10
+ // ===================================================================
+ /* 0 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);
+ /* 0 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+ /* 0 0 1 0 00 */ insert(impossible);
+ /* 0 0 1 0 01 */ insert(impossible);
+ /* 0 0 1 0 10 */ insert(impossible);
+ /* 0 0 1 0 11 */ insert(impossible);
+ /* 0 0 1 1 00 */ insert(impossible);
+ /* 0 0 1 1 01 */ insert(impossible);
+ /* 0 0 1 1 10 */ insert(impossible);
+ /* 0 0 1 1 11 */ insert(impossible);
+ /* 0 1 0 0 00 */ insert(invalid);
+ /* 0 1 0 0 01 */ insert(invalid);
+ /* 0 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+ /* 0 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+ /* 0 1 0 1 00 */ insert(invalid);
+ /* 0 1 0 1 01 */ insert(invalid);
+ /* 0 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+ /* 0 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+ /* 0 1 1 0 00 */ insert(invalid);
+ /* 0 1 1 0 01 */ insert(invalid);
+ /* 0 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);
+ /* 0 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+ /* 0 1 1 1 00 */ insert(invalid);
+ /* 0 1 1 1 01 */ insert(invalid);
+ /* 0 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
+ /* 0 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+ /* 1 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);
+ /* 1 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+ /* 1 0 1 0 00 */ insert(impossible);
+ /* 1 0 1 0 01 */ insert(impossible);
+ /* 1 0 1 0 10 */ insert(impossible);
+ /* 1 0 1 0 11 */ insert(impossible);
+ /* 1 0 1 1 00 */ insert(impossible);
+ /* 1 0 1 1 01 */ insert(impossible);
+ /* 1 0 1 1 10 */ insert(impossible);
+ /* 1 0 1 1 11 */ insert(impossible);
+ /* 1 1 0 0 00 */ insert(invalid);
+ /* 1 1 0 0 01 */ insert(invalid);
+ /* 1 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+ /* 1 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+ /* 1 1 0 1 00 */ insert(invalid);
+ /* 1 1 0 1 01 */ insert(invalid);
+ /* 1 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+ /* 1 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+ /* 1 1 1 0 00 */ insert(invalid);
+ /* 1 1 1 0 01 */ insert(invalid);
+ /* 1 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);
+ /* 1 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+ /* 1 1 1 1 00 */ insert(invalid);
+ /* 1 1 1 1 01 */ insert(invalid);
+ /* 1 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
+ /* 1 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+ }
+ builder.createGlobalConstant(
+ loc, tableTy, tableName, builder.createLinkOnceLinkage(),
+ mlir::DenseElementsAttr::get(
+ mlir::RankedTensorType::get(tableSize, int8Ty), values));
+ }
+
+ return builder.create<fir::CoordinateOp>(
+ loc, builder.getRefType(resultType),
+ builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy),
+ builder.getSymbolRefAttr(tableName)),
+ index);
+}
+
+// IEEE_COPY_SIGN
+mlir::Value
+IntrinsicLibrary::genIeeeCopySign(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Copy the sign of REAL arg Y to REAL arg X.
+ assert(args.size() == 2);
+ mlir::Value xRealVal = fir::getBase(args[0]);
+ mlir::Value yRealVal = fir::getBase(args[1]);
+ mlir::FloatType xRealType = xRealVal.getType().dyn_cast<mlir::FloatType>();
+ mlir::FloatType yRealType = yRealVal.getType().dyn_cast<mlir::FloatType>();
+
+ if (yRealType == mlir::FloatType::getBF16(builder.getContext())) {
+ // Workaround: CopySignOp and BitcastOp don't work for kind 3 arg Y.
+ // This conversion should always preserve the sign bit.
+ yRealVal = builder.createConvert(
+ loc, mlir::FloatType::getF32(builder.getContext()), yRealVal);
+ yRealType = mlir::FloatType::getF32(builder.getContext());
+ }
+
+ // Args have the same type.
+ if (xRealType == yRealType)
+ return builder.create<mlir::LLVM::CopySignOp>(loc, xRealVal, yRealVal);
+
+ // Args have
diff erent types.
+ mlir::Type xIntType = builder.getIntegerType(xRealType.getWidth());
+ mlir::Type yIntType = builder.getIntegerType(yRealType.getWidth());
+ mlir::Value xIntVal =
+ builder.create<mlir::arith::BitcastOp>(loc, xIntType, xRealVal);
+ mlir::Value yIntVal =
+ builder.create<mlir::arith::BitcastOp>(loc, yIntType, yRealVal);
+ mlir::Value xZero = builder.createIntegerConstant(loc, xIntType, 0);
+ mlir::Value yZero = builder.createIntegerConstant(loc, yIntType, 0);
+ mlir::Value xOne = builder.createIntegerConstant(loc, xIntType, 1);
+ mlir::Value ySign = builder.create<mlir::arith::ShRUIOp>(
+ loc, yIntVal,
+ builder.createIntegerConstant(loc, yIntType, yRealType.getWidth() - 1));
+ mlir::Value xAbs = builder.create<mlir::arith::ShRUIOp>(
+ loc, builder.create<mlir::arith::ShLIOp>(loc, xIntVal, xOne), xOne);
+ mlir::Value xSign = builder.create<mlir::arith::SelectOp>(
+ loc,
+ builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::eq,
+ ySign, yZero),
+ xZero,
+ builder.create<mlir::arith::ShLIOp>(
+ loc, xOne,
+ builder.createIntegerConstant(loc, xIntType,
+ xRealType.getWidth() - 1)));
+ return builder.create<mlir::arith::BitcastOp>(
+ loc, xRealType, builder.create<mlir::arith::OrIOp>(loc, xAbs, xSign));
+}
+
+// Check that an explicit ieee_[get|set]_rounding_mode call radix value is 2.
+static void checkRadix(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value radix, std::string procName) {
+ mlir::Value notTwo = builder.create<mlir::arith::CmpIOp>(
+ loc, mlir::arith::CmpIPredicate::ne, radix,
+ builder.createIntegerConstant(loc, radix.getType(), 2));
+ auto ifOp = builder.create<fir::IfOp>(loc, notTwo,
+ /*withElseRegion=*/false);
+ builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+ fir::runtime::genReportFatalUserError(builder, loc,
+ procName + " radix argument must be 2");
+ builder.setInsertionPointAfter(ifOp);
+}
+
+// IEEE_GET_ROUNDING_MODE
+void IntrinsicLibrary::genIeeeGetRoundingMode(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ // Set arg ROUNDING_VALUE to the current floating point rounding mode.
+ // Values are chosen to match the llvm.get.rounding encoding.
+ // Generate an error if the value of optional arg RADIX is not 2.
+ assert(args.size() == 1 || args.size() == 2);
+ if (args.size() == 2)
+ checkRadix(builder, loc, fir::getBase(args[1]), "ieee_get_rounding_mode");
+ auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
+ mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);
+ mlir::Value mode = builder.create<fir::CallOp>(loc, getRound).getResult(0);
+ mode = builder.createConvert(loc, fieldTy, mode);
+ builder.create<fir::StoreOp>(loc, mode, fieldRef);
+}
+
+mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args,
+ int fpclass) {
+ assert(args.size() == 1);
+ mlir::Type i1Ty = builder.getI1Type();
+ mlir::Value isfpclass =
+ builder.create<mlir::LLVM::IsFPClass>(loc, i1Ty, args[0], fpclass);
+ return builder.createConvert(loc, resultType, isfpclass);
+}
+
// IEEE_IS_FINITE
mlir::Value
IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
- // IEEE_IS_FINITE(X) is true iff exponent(X) is the max exponent of kind(X).
+ // Check if arg X is a (negative or positive) (normal, denormal, or zero).
assert(args.size() == 1);
- mlir::Value floatVal = fir::getBase(args[0]);
- mlir::FloatType floatType = floatVal.getType().dyn_cast<mlir::FloatType>();
- int floatBits = floatType.getWidth();
- mlir::Type intType = builder.getIntegerType(
- floatType.isa<mlir::Float80Type>() ? 128 : floatBits);
- mlir::Value intVal =
- builder.create<mlir::arith::BitcastOp>(loc, intType, floatVal);
- int significandBits;
- if (floatType.isa<mlir::Float32Type>())
- significandBits = 23;
- else if (floatType.isa<mlir::Float64Type>())
- significandBits = 52;
- else // problems elsewhere for other kinds
- TODO(loc, "intrinsic module procedure: ieee_is_finite");
- mlir::Value significand =
- builder.createIntegerConstant(loc, intType, significandBits);
- int exponentBits = floatBits - 1 - significandBits;
- mlir::Value maxExponent =
- builder.createIntegerConstant(loc, intType, (1 << exponentBits) - 1);
- mlir::Value exponent = genIbits(
- intType, {intVal, significand,
- builder.createIntegerConstant(loc, intType, exponentBits)});
- return builder.createConvert(
- loc, resultType,
- builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
- exponent, maxExponent));
+ return genIsFPClass(resultType, args, 0b0111111000);
+}
+
+// IEEE_IS_NAN
+mlir::Value IntrinsicLibrary::genIeeeIsNan(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Check if arg X is a (signaling or quiet) NaN.
+ assert(args.size() == 1);
+ return genIsFPClass(resultType, args, 0b0000000011);
+}
+
+// IEEE_IS_NEGATIVE
+mlir::Value
+IntrinsicLibrary::genIeeeIsNegative(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Check if arg X is a negative (infinity, normal, denormal or zero).
+ assert(args.size() == 1);
+ return genIsFPClass(resultType, args, 0b0000111100);
}
+// IEEE_IS_NORMAL
mlir::Value
IntrinsicLibrary::genIeeeIsNormal(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
- // Check if is positive or negative normal
- return genIsFPClass(resultType, args, 0b101101000);
+ // Check if arg X is a (negative or positive) (normal or zero).
+ assert(args.size() == 1);
+ return genIsFPClass(resultType, args, 0b0101101000);
+}
+
+// IEEE_SET_ROUNDING_MODE
+void IntrinsicLibrary::genIeeeSetRoundingMode(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ // Set the current floating point rounding mode to the value of arg
+ // ROUNDING_VALUE. Values are llvm.get.rounding encoding values.
+ // Generate an error if the value of optional arg RADIX is not 2.
+ assert(args.size() == 1 || args.size() == 2);
+ if (args.size() == 2)
+ checkRadix(builder, loc, fir::getBase(args[1]), "ieee_set_rounding_mode");
+ auto [fieldRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[0]));
+ mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder);
+ mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
+ mode = builder.create<fir::ConvertOp>(
+ loc, setRound.getFunctionType().getInput(0), mode);
+ builder.create<fir::CallOp>(loc, setRound, mode);
+}
+
+// IEEE_SIGNBIT
+mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Check if the sign bit of arg X is set.
+ assert(args.size() == 1);
+ mlir::Value realVal = fir::getBase(args[0]);
+ mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
+ int bitWidth = realType.getWidth();
+ if (realType == mlir::FloatType::getBF16(builder.getContext())) {
+ // Workaround: can't bitcast or convert real(3) to integer(2) or real(2).
+ realVal = builder.createConvert(
+ loc, mlir::FloatType::getF32(builder.getContext()), realVal);
+ bitWidth = 32;
+ }
+ mlir::Type intType = builder.getIntegerType(bitWidth);
+ mlir::Value intVal =
+ builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
+ mlir::Value shift = builder.createIntegerConstant(loc, intType, bitWidth - 1);
+ mlir::Value sign = builder.create<mlir::arith::ShRUIOp>(loc, intVal, shift);
+ return builder.createConvert(loc, resultType, sign);
+}
+
+// IEEE_SUPPORT_ROUNDING
+mlir::Value
+IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Check if floating point rounding mode ROUND_VALUE is supported.
+ // Rounding is supported either for all type kinds or none.
+ // An optional X kind argument is therefore ignored.
+ // Values are chosen to match the llvm.get.rounding encoding:
+ // 0 - toward zero [supported]
+ // 1 - to nearest, ties to even [supported] - default
+ // 2 - toward positive infinity [supported]
+ // 3 - toward negative infinity [supported]
+ // 4 - to nearest, ties away from zero [not supported]
+ assert(args.size() == 1 || args.size() == 2);
+ auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
+ mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
+ mlir::Value lbOk = builder.create<mlir::arith::CmpIOp>(
+ loc, mlir::arith::CmpIPredicate::sge, mode,
+ builder.createIntegerConstant(loc, fieldTy,
+ _FORTRAN_RUNTIME_IEEE_TO_ZERO));
+ mlir::Value ubOk = builder.create<mlir::arith::CmpIOp>(
+ loc, mlir::arith::CmpIPredicate::sle, mode,
+ builder.createIntegerConstant(loc, fieldTy, _FORTRAN_RUNTIME_IEEE_DOWN));
+ return builder.createConvert(
+ loc, resultType, builder.create<mlir::arith::AndIOp>(loc, lbOk, ubOk));
+}
+
+// IEEE_UNORDERED
+mlir::Value
+IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Check if REAL args X or Y or both are (signaling or quiet) NaNs.
+ assert(args.size() == 2);
+ mlir::Type i1Ty = builder.getI1Type();
+ mlir::Value xIsNan = genIsFPClass(i1Ty, args[0], 0b0000000011);
+ mlir::Value yIsNan = genIsFPClass(i1Ty, args[1], 0b0000000011);
+ mlir::Value res = builder.create<mlir::arith::OrIOp>(loc, xIsNan, yIsNan);
+ return builder.createConvert(loc, resultType, res);
+}
+
+// IEEE_VALUE
+mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Return a KIND(X) REAL number of IEEE_CLASS_TYPE CLASS.
+ assert(args.size() == 2);
+ mlir::FloatType realType =
+ fir::getBase(args[0]).getType().dyn_cast<mlir::FloatType>();
+ int bitWidth = realType.getWidth();
+ mlir::Type intType = builder.getIntegerType(bitWidth);
+ mlir::Type valueTy = bitWidth <= 64 ? intType : builder.getIntegerType(64);
+ constexpr int tableSize = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE + 1;
+ mlir::Type tableTy = fir::SequenceType::get(tableSize, valueTy);
+ std::string tableName = RTNAME_STRING(IeeeValueTable_) +
+ std::to_string(realType.isBF16() ? 3 : bitWidth >> 3);
+ if (!builder.getNamedGlobal(tableName)) {
+ llvm::SmallVector<mlir::Attribute, tableSize> values;
+ auto insert = [&](std::int64_t v) {
+ values.push_back(builder.getIntegerAttr(valueTy, v));
+ };
+ insert(0); // placeholder
+ switch (bitWidth) {
+ case 16:
+ if (realType.isF16()) {
+ // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
+ /* IEEE_SIGNALING_NAN */ insert(0x7d00);
+ /* IEEE_QUIET_NAN */ insert(0x7e00);
+ /* IEEE_NEGATIVE_INF */ insert(0xfc00);
+ /* IEEE_NEGATIVE_NORMAL */ insert(0xbc00);
+ /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8200);
+ /* IEEE_NEGATIVE_ZERO */ insert(0x8000);
+ /* IEEE_POSITIVE_ZERO */ insert(0x0000);
+ /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0200);
+ /* IEEE_POSITIVE_NORMAL */ insert(0x3c00); // 1.0
+ /* IEEE_POSITIVE_INF */ insert(0x7c00);
+ break;
+ }
+ assert(realType.isBF16() && "unknown 16-bit real type");
+ // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
+ /* IEEE_SIGNALING_NAN */ insert(0x7fa0);
+ /* IEEE_QUIET_NAN */ insert(0x7fc0);
+ /* IEEE_NEGATIVE_INF */ insert(0xff80);
+ /* IEEE_NEGATIVE_NORMAL */ insert(0xbf80);
+ /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8040);
+ /* IEEE_NEGATIVE_ZERO */ insert(0x8000);
+ /* IEEE_POSITIVE_ZERO */ insert(0x0000);
+ /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0040);
+ /* IEEE_POSITIVE_NORMAL */ insert(0x3f80); // 1.0
+ /* IEEE_POSITIVE_INF */ insert(0x7f80);
+ break;
+ case 32:
+ // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
+ /* IEEE_SIGNALING_NAN */ insert(0x7fa00000);
+ /* IEEE_QUIET_NAN */ insert(0x7fc00000);
+ /* IEEE_NEGATIVE_INF */ insert(0xff800000);
+ /* IEEE_NEGATIVE_NORMAL */ insert(0xbf800000);
+ /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x80400000);
+ /* IEEE_NEGATIVE_ZERO */ insert(0x80000000);
+ /* IEEE_POSITIVE_ZERO */ insert(0x00000000);
+ /* IEEE_POSITIVE_SUBNORMAL */ insert(0x00400000);
+ /* IEEE_POSITIVE_NORMAL */ insert(0x3f800000); // 1.0
+ /* IEEE_POSITIVE_INF */ insert(0x7f800000);
+ break;
+ case 64:
+ // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
+ /* IEEE_SIGNALING_NAN */ insert(0x7ff4000000000000);
+ /* IEEE_QUIET_NAN */ insert(0x7ff8000000000000);
+ /* IEEE_NEGATIVE_INF */ insert(0xfff0000000000000);
+ /* IEEE_NEGATIVE_NORMAL */ insert(0xbff0000000000000);
+ /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8008000000000000);
+ /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
+ /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
+ /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0008000000000000);
+ /* IEEE_POSITIVE_NORMAL */ insert(0x3ff0000000000000); // 1.0
+ /* IEEE_POSITIVE_INF */ insert(0x7ff0000000000000);
+ break;
+ case 80:
+ // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
+ // 64 high order bits; 16 low order bits are 0.
+ /* IEEE_SIGNALING_NAN */ insert(0x7fffa00000000000);
+ /* IEEE_QUIET_NAN */ insert(0x7fffc00000000000);
+ /* IEEE_NEGATIVE_INF */ insert(0xffff800000000000);
+ /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff800000000000);
+ /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000400000000000);
+ /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
+ /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
+ /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000400000000000);
+ /* IEEE_POSITIVE_NORMAL */ insert(0x3fff800000000000); // 1.0
+ /* IEEE_POSITIVE_INF */ insert(0x7fff800000000000);
+ break;
+ case 128:
+ // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
+ // 64 high order bits; 64 low order bits are 0.
+ /* IEEE_SIGNALING_NAN */ insert(0x7fff400000000000);
+ /* IEEE_QUIET_NAN */ insert(0x7fff800000000000);
+ /* IEEE_NEGATIVE_INF */ insert(0xffff000000000000);
+ /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff000000000000);
+ /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000200000000000);
+ /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
+ /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
+ /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000200000000000);
+ /* IEEE_POSITIVE_NORMAL */ insert(0x3fff000000000000); // 1.0
+ /* IEEE_POSITIVE_INF */ insert(0x7fff000000000000);
+ break;
+ default:
+ llvm_unreachable("unknown real type");
+ }
+ insert(0); // IEEE_OTHER_VALUE
+ assert(values.size() == tableSize && "ieee value mismatch");
+ builder.createGlobalConstant(
+ loc, tableTy, tableName, builder.createLinkOnceLinkage(),
+ mlir::DenseElementsAttr::get(
+ mlir::RankedTensorType::get(tableSize, valueTy), values));
+ }
+
+ auto [fieldRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[1]));
+ mlir::Value which = builder.create<fir::LoadOp>(loc, fieldRef);
+ mlir::Value bits = builder.create<fir::LoadOp>(
+ loc,
+ builder.create<fir::CoordinateOp>(
+ loc, builder.getRefType(valueTy),
+ builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy),
+ builder.getSymbolRefAttr(tableName)),
+ which));
+ if (bitWidth > 64)
+ bits = builder.create<mlir::arith::ShLIOp>(
+ loc, builder.createConvert(loc, intType, bits),
+ builder.createIntegerConstant(loc, intType, bitWidth - 64));
+ return builder.create<mlir::arith::BitcastOp>(loc, realType, bits);
}
// IEOR
@@ -3368,24 +3962,6 @@ IntrinsicLibrary::genIsIostatValue(mlir::Type resultType,
builder.createIntegerConstant(loc, args[0].getType(), value));
}
-mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType,
- llvm::ArrayRef<mlir::Value> args,
- int fpclass) {
- assert(args.size() == 1);
- mlir::MLIRContext *context = builder.getContext();
- mlir::IntegerType i1ty = mlir::IntegerType::get(context, 1);
-
- mlir::Value isfpclass =
- builder.create<mlir::LLVM::IsFPClass>(loc, i1ty, args[0], fpclass);
- return builder.createConvert(loc, resultType, isfpclass);
-}
-
-mlir::Value IntrinsicLibrary::genIsNan(mlir::Type resultType,
- llvm::ArrayRef<mlir::Value> args) {
- // Check is signaling or quiet nan
- return genIsFPClass(resultType, args, 0b11);
-}
-
// ISHFT
mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
@@ -4511,7 +5087,6 @@ IntrinsicLibrary::genLbound(mlir::Type resultType,
if (boxValue->hasAssumedRank())
TODO(loc, "intrinsic: lbound with assumed rank argument");
- //===----------------------------------------------------------------------===//
mlir::Type indexType = builder.getIndexType();
// Semantics builds signatures for LBOUND calls as either
diff --git a/flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp b/flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp
index eea4385b1904b1..5d6edf8928ca8f 100644
--- a/flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp
@@ -59,6 +59,24 @@ mlir::func::FuncOp fir::factory::getRealloc(fir::FirOpBuilder &builder) {
reallocTy);
}
+mlir::func::FuncOp
+fir::factory::getLlvmGetRounding(fir::FirOpBuilder &builder) {
+ auto int32Ty = builder.getIntegerType(32);
+ auto funcTy =
+ mlir::FunctionType::get(builder.getContext(), std::nullopt, {int32Ty});
+ return builder.addNamedFunction(builder.getUnknownLoc(), "llvm.get.rounding",
+ funcTy);
+}
+
+mlir::func::FuncOp
+fir::factory::getLlvmSetRounding(fir::FirOpBuilder &builder) {
+ auto int32Ty = builder.getIntegerType(32);
+ auto funcTy =
+ mlir::FunctionType::get(builder.getContext(), {int32Ty}, std::nullopt);
+ return builder.addNamedFunction(builder.getUnknownLoc(), "llvm.set.rounding",
+ funcTy);
+}
+
mlir::func::FuncOp fir::factory::getLlvmStackSave(fir::FirOpBuilder &builder) {
auto ptrTy = builder.getRefType(builder.getIntegerType(8));
auto funcTy =
diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90
index 64a5b25728e288..36792ed96629eb 100644
--- a/flang/module/ieee_arithmetic.f90
+++ b/flang/module/ieee_arithmetic.f90
@@ -8,6 +8,9 @@
! Fortran 2018 Clause 17
+! ieee_class_type and ieee_round_type values
+include '../include/flang/Runtime/ieee_arithmetic.h'
+
module ieee_arithmetic
! 17.1: "The module IEEE_ARITHMETIC behaves as if it contained a
! USE statement for IEEE_EXCEPTIONS; everything that is public in
@@ -43,21 +46,21 @@ module ieee_arithmetic
end type ieee_class_type
type(ieee_class_type), parameter :: &
- ieee_signaling_nan = ieee_class_type(1), &
- ieee_quiet_nan = ieee_class_type(2), &
- ieee_negative_inf = ieee_class_type(3), &
- ieee_negative_normal = ieee_class_type(4), &
- ieee_negative_denormal = ieee_class_type(5), &
- ieee_negative_zero = ieee_class_type(6), &
- ieee_positive_zero = ieee_class_type(7), &
- ieee_positive_subnormal = ieee_class_type(8), &
- ieee_positive_normal = ieee_class_type(9), &
- ieee_positive_inf = ieee_class_type(10), &
- ieee_other_value = ieee_class_type(11)
+ ieee_signaling_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN), &
+ ieee_quiet_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_QUIET_NAN), &
+ ieee_negative_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF), &
+ ieee_negative_normal = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL), &
+ ieee_negative_subnormal = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL), &
+ ieee_negative_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO), &
+ ieee_positive_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO), &
+ ieee_positive_subnormal = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL), &
+ ieee_positive_normal = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL), &
+ ieee_positive_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF), &
+ ieee_other_value = ieee_class_type(_FORTRAN_RUNTIME_IEEE_OTHER_VALUE)
type(ieee_class_type), parameter :: &
- ieee_negative_subnormal = ieee_negative_denormal, &
- ieee_positive_denormal = ieee_negative_subnormal
+ ieee_negative_denormal = ieee_negative_subnormal, &
+ ieee_positive_denormal = ieee_positive_subnormal
type :: ieee_round_type
private
@@ -65,12 +68,12 @@ module ieee_arithmetic
end type ieee_round_type
type(ieee_round_type), parameter :: &
- ieee_nearest = ieee_round_type(1), &
- ieee_to_zero = ieee_round_type(2), &
- ieee_up = ieee_round_type(3), &
- ieee_down = ieee_round_type(4), &
- ieee_away = ieee_round_type(5), &
- ieee_other = ieee_round_type(6)
+ ieee_to_zero = ieee_round_type(_FORTRAN_RUNTIME_IEEE_TO_ZERO), &
+ ieee_nearest = ieee_round_type(_FORTRAN_RUNTIME_IEEE_NEAREST), &
+ ieee_up = ieee_round_type(_FORTRAN_RUNTIME_IEEE_UP), &
+ ieee_down = ieee_round_type(_FORTRAN_RUNTIME_IEEE_DOWN), &
+ ieee_away = ieee_round_type(_FORTRAN_RUNTIME_IEEE_AWAY), &
+ ieee_other = ieee_round_type(_FORTRAN_RUNTIME_IEEE_OTHER)
interface operator(==)
elemental logical function ieee_class_eq(x, y)
diff --git a/flang/test/Lower/Intrinsics/ieee_class.f90 b/flang/test/Lower/Intrinsics/ieee_class.f90
new file mode 100644
index 00000000000000..b003284b4b5f8b
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_class.f90
@@ -0,0 +1,142 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+#ifndef RK
+#define RK 8
+#endif
+
+module m
+ integer, parameter :: k = RK
+ character(20) :: tag(11)
+contains
+ ! CHECK-LABEL: func @_QMmPinit
+ subroutine init
+ tag( 1) = 'signaling_nan'; tag( 2) = 'quiet_nan'
+ tag( 3) = 'negative_inf'; tag( 4) = 'negative_normal'
+ tag( 5) = 'negative_denormal'; tag( 6) = 'negative_zero'
+ tag( 7) = 'positive_zero'; tag( 8) = 'positive_denormal'
+ tag( 9) = 'positive_normal'; tag(10) = 'positive_inf'
+ tag(11) = 'other_value'
+ end
+ ! CHECK-LABEL: func @_QMmPout
+ subroutine out(x,v)
+ use ieee_arithmetic
+ real(k) :: x
+ integer :: v
+ logical :: L(4)
+ L(1) = ieee_is_finite(x)
+ L(2) = ieee_is_nan(x)
+ L(3) = ieee_is_negative(x)
+ L(4) = ieee_is_normal(x)
+! if (k== 2) print "(' k=2 ',f7.2,z6.4, i4,': ',a18,4L2)", x,x, v, tag(v), L
+! if (k== 3) print "(' k=3 ',f7.2,z6.4, i4,': ',a18,4L2)", x,x, v, tag(v), L
+! if (k== 4) print "(' k=4 ',f7.2,z10.8, i4,': ',a18,4L2)", x,x, v, tag(v), L
+ if (k== 8) print "(' k=8 ',f7.2,z18.16,i4,': ',a18,4L2)", x,x, v, tag(v), L
+! if (k==10) print "(' k=10',f7.2,z22.20,i4,': ',a18,4L2)", x,x, v, tag(v), L
+! if (k==16) print "(' k=16',f7.2,z34.32,i4,': ',a18,4L2)", x,x, v, tag(v), L
+ end
+end module m
+
+! CHECK-LABEL: func @_QPclassify
+subroutine classify(x)
+ use m; use ieee_arithmetic
+ real(k) :: x
+ ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca i32 {adapt.valuebyref}
+ ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK-DAG: %[[V_2:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}> {bindc_name = "r", uniq_name = "_QFclassifyEr"}
+ type(ieee_class_type) :: r
+
+ ! CHECK: %[[V_8:[0-9]+]] = fir.load %arg0 : !fir.ref<f64>
+ ! CHECK: %[[V_9:[0-9]+]] = arith.bitcast %[[V_8]] : f64 to i64
+ ! CHECK: %[[V_10:[0-9]+]] = arith.shrui %[[V_9]], %c59{{.*}} : i64
+ ! CHECK: %[[V_11:[0-9]+]] = arith.andi %[[V_10]], %c16{{.*}} : i64
+ ! CHECK: %[[V_12:[0-9]+]] = arith.andi %[[V_9]], %c9218868437227405312{{.*}} : i64
+ ! CHECK: %[[V_13:[0-9]+]] = arith.cmpi ne, %[[V_12]], %c0{{.*}} : i64
+ ! CHECK: %[[V_14:[0-9]+]] = arith.select %[[V_13]], %c8{{.*}}, %c0{{.*}} : i64
+ ! CHECK: %[[V_15:[0-9]+]] = arith.ori %[[V_11]], %[[V_14]] : i64
+ ! CHECK: %[[V_16:[0-9]+]] = arith.cmpi eq, %[[V_12]], %c9218868437227405312{{.*}} : i64
+ ! CHECK: %[[V_17:[0-9]+]] = arith.select %[[V_16]], %c4{{.*}}, %c0{{.*}} : i64
+ ! CHECK: %[[V_18:[0-9]+]] = arith.ori %[[V_15]], %[[V_17]] : i64
+ ! CHECK: %[[V_19:[0-9]+]] = arith.andi %[[V_9]], %c2251799813685247{{.*}} : i64
+ ! CHECK: %[[V_20:[0-9]+]] = arith.cmpi ne, %[[V_19]], %c0{{.*}} : i64
+ ! CHECK: %[[V_21:[0-9]+]] = arith.select %[[V_20]], %c2{{.*}}, %c0{{.*}} : i64
+ ! CHECK: %[[V_22:[0-9]+]] = arith.ori %[[V_18]], %[[V_21]] : i64
+ ! CHECK: %[[V_23:[0-9]+]] = arith.shrui %[[V_9]], %c51{{.*}} : i64
+ ! CHECK: %[[V_24:[0-9]+]] = arith.andi %[[V_23]], %c1{{.*}} : i64
+ ! CHECK: %[[V_25:[0-9]+]] = arith.ori %[[V_22]], %[[V_24]] : i64
+ ! CHECK: %[[V_26:[0-9]+]] = fir.address_of(@_FortranAIeeeClassTable) : !fir.ref<!fir.array<32xi8>>
+ ! CHECK: %[[V_27:[0-9]+]] = fir.coordinate_of %[[V_26]], %[[V_25]] : (!fir.ref<!fir.array<32xi8>>, i64) -> !fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>
+ ! CHECK: %[[V_28:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_29:[0-9]+]] = fir.coordinate_of %[[V_27]], %[[V_28]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_30:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_31:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_30]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_32:[0-9]+]] = fir.load %[[V_29]] : !fir.ref<i8>
+ ! CHECK: fir.store %[[V_32]] to %[[V_31]] : !fir.ref<i8>
+ r = ieee_class(x)
+
+! if (r==ieee_signaling_nan) call out(x, 1)
+! if (r==ieee_quiet_nan) call out(x, 2)
+ ! CHECK: %[[V_38:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_39:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_38]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c3{{.*}} to %[[V_39]] : !fir.ref<i8>
+ ! CHECK: %[[V_40:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_41:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_40]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_42:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_43:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_42]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_44:[0-9]+]] = fir.load %[[V_41]] : !fir.ref<i8>
+ ! CHECK: %[[V_45:[0-9]+]] = fir.load %[[V_43]] : !fir.ref<i8>
+ ! CHECK: %[[V_46:[0-9]+]] = arith.cmpi eq, %[[V_44]], %[[V_45]] : i8
+ ! CHECK: fir.if %[[V_46]] {
+ ! CHECK: fir.store %c3{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: fir.call @_QMmPout(%arg0, %[[V_0]]) {{.*}} : (!fir.ref<f64>, !fir.ref<i32>) -> ()
+ ! CHECK: }
+ if (r==ieee_negative_inf) call out(x, 3)
+! if (r==ieee_negative_normal) call out(x, 4)
+! if (r==ieee_negative_denormal) call out(x, 5)
+! if (r==ieee_negative_zero) call out(x, 6)
+! if (r==ieee_positive_zero) call out(x, 7)
+! if (r==ieee_positive_denormal) call out(x, 8)
+! if (r==ieee_positive_normal) call out(x, 9)
+! if (r==ieee_positive_inf) call out(x,10)
+! if (r==ieee_other_value) call out(x,11)
+end
+
+! CHECK-LABEL: func @_QQmain
+program p
+ use m; use ieee_arithmetic
+ real(k) :: x(10)
+
+ call init
+
+! x(1) = ieee_value(x(1), ieee_signaling_nan)
+! x(2) = ieee_value(x(1), ieee_quiet_nan)
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_2:[0-9]+]] = fir.address_of(@_QFEx) : !fir.ref<!fir.array<10xf64>>
+ ! CHECK: %[[V_8:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_9:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_8]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c3{{.*}} to %[[V_9]] : !fir.ref<i8>
+ ! CHECK: %[[V_10:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_11:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_10]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_11]] : !fir.ref<i8>
+ ! CHECK: %[[V_13:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_8) : !fir.ref<!fir.array<12xi64>>
+ ! CHECK: %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_13]], %[[V_12]] : (!fir.ref<!fir.array<12xi64>>, i8) -> !fir.ref<i64>
+ ! CHECK: %[[V_15:[0-9]+]] = fir.load %[[V_14]] : !fir.ref<i64>
+ ! CHECK: %[[V_16:[0-9]+]] = arith.bitcast %[[V_15]] : i64 to f64
+ ! CHECK: %[[V_17:[0-9]+]] = arith.subi %c3{{.*}}, %c1{{.*}} : i64
+ ! CHECK: %[[V_18:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_17]] : (!fir.ref<!fir.array<10xf64>>, i64) -> !fir.ref<f64>
+ ! CHECK: fir.store %[[V_16]] to %[[V_18]] : !fir.ref<f64>
+ x(3) = ieee_value(x(1), ieee_negative_inf)
+! x(4) = ieee_value(x(1), ieee_negative_normal)
+! x(5) = ieee_value(x(1), ieee_negative_subnormal)
+! x(6) = ieee_value(x(1), ieee_negative_zero)
+! x(7) = ieee_value(x(1), ieee_positive_zero)
+! x(8) = ieee_value(x(1), ieee_positive_subnormal)
+! x(9) = ieee_value(x(1), ieee_positive_normal)
+! x(10) = ieee_value(x(1), ieee_positive_inf)
+
+ do i = 1,10
+ call classify(x(i))
+ enddo
+end
+
+! CHECK: fir.global linkonce @_FortranAIeeeClassTable(dense<[7, 8, 8, 8, 11, 11, 11, 11, 9, 9, 9, 9, 10, 2, 1, 2, 6, 5, 5, 5, 11, 11, 11, 11, 4, 4, 4, 4, 3, 2, 1, 2]> : tensor<32xi8>) constant : !fir.array<32xi8>
+! CHECK: fir.global linkonce @_FortranAIeeeValueTable_8(dense<[0, 9219994337134247936, 9221120237041090560, -4503599627370496, -4616189618054758400, -9221120237041090560, -9223372036854775808, 0, 2251799813685248, 4607182418800017408, 9218868437227405312, 0]> : tensor<12xi64>) constant : !fir.array<12xi64>
diff --git a/flang/test/Lower/Intrinsics/ieee_class_queries.f90 b/flang/test/Lower/Intrinsics/ieee_class_queries.f90
new file mode 100644
index 00000000000000..ac5904c18174aa
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_class_queries.f90
@@ -0,0 +1,55 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+ ! CHECK-LABEL: func @_QQmain
+ use ieee_arithmetic, only: ieee_is_finite, ieee_is_nan, ieee_is_negative, &
+ ieee_is_normal
+ real(2) :: x2 = -2.0
+ real(3) :: x3 = -3.0
+ real(4) :: x4 = -4.0
+ real(8) :: x8 = -8.0
+ real(10) :: x10 = -10.0
+ real(16) :: x16 = -16.0
+
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f16) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f16) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f16) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f16) -> i1
+ print*, ieee_is_finite(x2), ieee_is_negative(x2), ieee_is_normal(x2), &
+ ieee_is_nan(x2)
+
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (bf16) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (bf16) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (bf16) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (bf16) -> i1
+ print*, ieee_is_finite(x3), ieee_is_negative(x3), ieee_is_normal(x3), &
+ ieee_is_nan(x3)
+
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f32) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f32) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f32) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f32) -> i1
+ print*, ieee_is_finite(x4), ieee_is_negative(x4), ieee_is_normal(x4), &
+ ieee_is_nan(x4)
+
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f64) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f64) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f64) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f64) -> i1
+ print*, ieee_is_finite(x8), ieee_is_negative(x8), ieee_is_normal(x8), &
+ ieee_is_nan(x8)
+
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f80) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f80) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f80) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f80) -> i1
+ print*, ieee_is_finite(x10), ieee_is_negative(x10), ieee_is_normal(x10), &
+ ieee_is_nan(x10)
+
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f128) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f128) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f128) -> i1
+ ! CHECK: "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f128) -> i1
+ print*, ieee_is_finite(x16), ieee_is_negative(x16), ieee_is_normal(x16), &
+ ieee_is_nan(x16)
+
+ end
diff --git a/flang/test/Lower/Intrinsics/ieee_copy_sign.f90 b/flang/test/Lower/Intrinsics/ieee_copy_sign.f90
new file mode 100644
index 00000000000000..61005f6a858585
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_copy_sign.f90
@@ -0,0 +1,51 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+program cs
+ use ieee_arithmetic
+
+ ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca f16 {adapt.valuebyref}
+ ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_2:[0-9]+]] = fir.address_of(@_QFEx2) : !fir.ref<f16>
+ ! CHECK: %[[V_3:[0-9]+]] = fir.address_of(@_QFEx4) : !fir.ref<f32>
+ ! CHECK: %[[V_4:[0-9]+]] = fir.address_of(@_QFEy4) : !fir.ref<f32>
+ real(2) :: x2 = 2.0
+ real(4) :: x4 = 4.0
+ real(4) :: y4 = -100.0
+
+ ! CHECK: %[[V_8:[0-9]+]] = fir.load %[[V_3]] : !fir.ref<f32>
+ ! CHECK: %[[V_9:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<f32>
+ ! CHECK: %[[V_10:[0-9]+]] = llvm.intr.copysign(%[[V_8]], %[[V_9]]) : (f32, f32) -> f32
+ ! CHECK: %[[V_11:[0-9]+]] = fir.call @_FortranAioOutputReal32(%{{.*}}, %[[V_10]]) {{.*}} : (!fir.ref<i8>, f32) -> i1
+ print*, ieee_copy_sign(x4, y4)
+
+ ! CHECK: %[[V_16:[0-9]+]] = fir.load %[[V_2]] : !fir.ref<f16>
+ ! CHECK: %[[V_22:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_23:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_22]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c2{{.*}} to %[[V_23]] : !fir.ref<i8>
+
+ ! CHECK: %[[V_24:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+ ! CHECK: %[[V_25:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_24]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_26:[0-9]+]] = fir.load %[[V_25]] : !fir.ref<i8>
+ ! CHECK: %[[V_27:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref<!fir.array<12xi64>>
+ ! CHECK: %[[V_28:[0-9]+]] = fir.coordinate_of %[[V_27]], %[[V_26]] : (!fir.ref<!fir.array<12xi64>>, i8) -> !fir.ref<i64>
+ ! CHECK: %[[V_29:[0-9]+]] = fir.load %[[V_28]] : !fir.ref<i64>
+ ! CHECK: %[[V_30:[0-9]+]] = fir.convert %[[V_29]] : (i64) -> i128
+ ! CHECK: %[[V_31:[0-9]+]] = arith.shli %[[V_30]], %c64{{.*}} : i128
+ ! CHECK: %[[V_32:[0-9]+]] = arith.bitcast %[[V_31]] : i128 to f128
+ ! CHECK: %[[V_33:[0-9]+]] = arith.negf %[[V_32]] {{.*}} : f128
+ ! CHECK: %[[V_34:[0-9]+]] = arith.bitcast %[[V_16]] : f16 to i16
+ ! CHECK: %[[V_35:[0-9]+]] = arith.bitcast %[[V_33]] : f128 to i128
+ ! CHECK: %[[V_36:[0-9]+]] = arith.shrui %[[V_35]], %c127{{.*}} : i128
+ ! CHECK: %[[V_37:[0-9]+]] = arith.shli %[[V_34]], %c1{{.*}} : i16
+ ! CHECK: %[[V_38:[0-9]+]] = arith.shrui %[[V_37]], %c1{{.*}} : i16
+ ! CHECK: %[[V_39:[0-9]+]] = arith.shli %c1{{.*}}, %c15{{.*}} : i16
+ ! CHECK: %[[V_40:[0-9]+]] = arith.cmpi eq, %[[V_36]], %c0{{.*}} : i128
+ ! CHECK: %[[V_41:[0-9]+]] = arith.select %[[V_40]], %c0{{.*}}, %[[V_39]] : i16
+ ! CHECK: %[[V_42:[0-9]+]] = arith.ori %[[V_38]], %[[V_41]] : i16
+ ! CHECK: %[[V_43:[0-9]+]] = arith.bitcast %[[V_42]] : i16 to f16
+ ! CHECK: fir.store %[[V_43]] to %[[V_0]] : !fir.ref<f16>
+ print*, ieee_copy_sign(x2, -ieee_value(0.0_16, ieee_quiet_nan))
+end
+
+! CHECK: fir.global linkonce @_FortranAIeeeValueTable_16(dense<[0, 9223160930622242816, 9223231299366420480, -281474976710656, -4611967493404098560, -9223336852482686976, -9223372036854775808, 0, 35184372088832, 4611404543450677248, 9223090561878065152, 0]> : tensor<12xi64>) constant : !fir.array<12xi64>
diff --git a/flang/test/Lower/Intrinsics/ieee_is_finite.f90 b/flang/test/Lower/Intrinsics/ieee_is_finite.f90
index 69d1b694f7765f..db226c0d0a5ce7 100644
--- a/flang/test/Lower/Intrinsics/ieee_is_finite.f90
+++ b/flang/test/Lower/Intrinsics/ieee_is_finite.f90
@@ -1,68 +1,53 @@
! RUN: bbc -emit-fir %s -o - | FileCheck %s
-! CHECK-LABEL: @_QPis_finite_test
+! CHECK-LABEL: c.func @_QPis_finite_test
subroutine is_finite_test(x, y)
use ieee_arithmetic, only: ieee_is_finite
real(4) x
real(8) y
- ! CHECK: %[[V_3:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
- ! CHECK: %[[V_4:[0-9]+]] = arith.bitcast %[[V_3]] : f32 to i32
- ! CHECK: %[[V_5:[0-9]+]] = arith.subi %c32{{.*}}, %c8{{.*}} : i32
- ! CHECK: %[[V_6:[0-9]+]] = arith.shrui %c-1{{.*}}, %[[V_5]] : i32
- ! CHECK: %[[V_7:[0-9]+]] = arith.shrsi %[[V_4]], %c23{{.*}} : i32
- ! CHECK: %[[V_8:[0-9]+]] = arith.andi %[[V_7]], %[[V_6]] : i32
- ! CHECK: %[[V_9:[0-9]+]] = arith.cmpi eq, %c8{{.*}}, %c0{{.*}} : i32
- ! CHECK: %[[V_10:[0-9]+]] = arith.select %[[V_9]], %c0{{.*}}, %[[V_8]] : i32
- ! CHECK: %[[V_11:[0-9]+]] = arith.cmpi ne, %[[V_10]], %c255{{.*}} : i32
- ! CHECK: %[[V_12:[0-9]+]] = fir.convert %[[V_11]] : (i1) -> !fir.logical<4>
- ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_12]] : (!fir.logical<4>) -> i1
+
+ ! CHECK: %[[V_3:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+ ! CHECK: %[[V_4:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_3]]) <{bit = 504 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_5:[0-9]+]] = fir.convert %[[V_4]] : (i1) -> !fir.logical<4>
+ ! CHECK: %[[V_6:[0-9]+]] = fir.convert %[[V_5]] : (!fir.logical<4>) -> i1
+ ! CHECK: %[[V_7:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_6]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
print*, ieee_is_finite(x)
- ! CHECK: %[[V_19:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
- ! CHECK: %[[V_20:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
- ! CHECK: %[[V_21:[0-9]+]] = arith.addf %[[V_19]], %[[V_20]] {{.*}}: f32
- ! CHECK: %[[V_22:[0-9]+]] = arith.bitcast %[[V_21]] : f32 to i32
- ! CHECK: %[[V_23:[0-9]+]] = arith.subi %c32{{.*}}, %c8{{.*}} : i32
- ! CHECK: %[[V_24:[0-9]+]] = arith.shrui %c-1{{.*}}, %[[V_23]] : i32
- ! CHECK: %[[V_25:[0-9]+]] = arith.shrsi %[[V_22]], %c23{{.*}} : i32
- ! CHECK: %[[V_26:[0-9]+]] = arith.andi %[[V_25]], %[[V_24]] : i32
- ! CHECK: %[[V_27:[0-9]+]] = arith.cmpi eq, %c8{{.*}}, %c0{{.*}} : i32
- ! CHECK: %[[V_28:[0-9]+]] = arith.select %[[V_27]], %c0{{.*}}, %[[V_26]] : i32
- ! CHECK: %[[V_29:[0-9]+]] = arith.cmpi ne, %[[V_28]], %c255{{.*}} : i32
- ! CHECK: %[[V_30:[0-9]+]] = fir.convert %[[V_29]] : (i1) -> !fir.logical<4>
- ! CHECK: %[[V_31:[0-9]+]] = fir.convert %[[V_30]] : (!fir.logical<4>) -> i1
+ ! CHECK: %[[V_12:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+ ! CHECK: %[[V_13:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+ ! CHECK: %[[V_14:[0-9]+]] = arith.addf %[[V_12]], %[[V_13]] {{.*}} : f32
+ ! CHECK: %[[V_15:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_14]]) <{bit = 504 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_16:[0-9]+]] = fir.convert %[[V_15]] : (i1) -> !fir.logical<4>
+ ! CHECK: %[[V_17:[0-9]+]] = fir.convert %[[V_16]] : (!fir.logical<4>) -> i1
+ ! CHECK: %[[V_18:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_17]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
print*, ieee_is_finite(x+x)
- ! CHECK: %[[V_37:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
- ! CHECK: %[[V_38:[0-9]+]] = arith.bitcast %[[V_37]] : f64 to i64
- ! CHECK: %[[V_39:[0-9]+]] = arith.subi %c64{{.*}}, %c11{{.*}} : i64
- ! CHECK: %[[V_40:[0-9]+]] = arith.shrui %c-1{{.*}}, %[[V_39]] : i64
- ! CHECK: %[[V_41:[0-9]+]] = arith.shrsi %[[V_38]], %c52{{.*}} : i64
- ! CHECK: %[[V_42:[0-9]+]] = arith.andi %[[V_41]], %[[V_40]] : i64
- ! CHECK: %[[V_43:[0-9]+]] = arith.cmpi eq, %c11{{.*}}, %c0{{.*}} : i64
- ! CHECK: %[[V_44:[0-9]+]] = arith.select %[[V_43]], %c0{{.*}}, %[[V_42]] : i64
- ! CHECK: %[[V_45:[0-9]+]] = arith.cmpi ne, %[[V_44]], %c2047{{.*}} : i64
- ! CHECK: %[[V_46:[0-9]+]] = fir.convert %[[V_45]] : (i1) -> !fir.logical<4>
- ! CHECK: %[[V_47:[0-9]+]] = fir.convert %[[V_46]] : (!fir.logical<4>) -> i1
+ ! CHECK: %[[V_23:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
+ ! CHECK: %[[V_24:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_23]]) <{bit = 504 : i32}> : (f64) -> i1
+ ! CHECK: %[[V_25:[0-9]+]] = fir.convert %[[V_24]] : (i1) -> !fir.logical<4>
+ ! CHECK: %[[V_26:[0-9]+]] = fir.convert %[[V_25]] : (!fir.logical<4>) -> i1
+ ! CHECK: %[[V_27:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_26]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
print*, ieee_is_finite(y)
- ! CHECK: %[[V_53:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
- ! CHECK: %[[V_54:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
- ! CHECK: %[[V_55:[0-9]+]] = arith.addf %[[V_53]], %[[V_54]] {{.*}}: f64
- ! CHECK: %[[V_56:[0-9]+]] = arith.bitcast %[[V_55]] : f64 to i64
- ! CHECK: %[[V_57:[0-9]+]] = arith.subi %c64{{.*}}, %c11{{.*}} : i64
- ! CHECK: %[[V_58:[0-9]+]] = arith.shrui %c-1{{.*}}, %[[V_57]] : i64
- ! CHECK: %[[V_59:[0-9]+]] = arith.shrsi %[[V_56]], %c52{{.*}} : i64
- ! CHECK: %[[V_60:[0-9]+]] = arith.andi %[[V_59]], %[[V_58]] : i64
- ! CHECK: %[[V_61:[0-9]+]] = arith.cmpi eq, %c11{{.*}}, %c0{{.*}} : i64
- ! CHECK: %[[V_62:[0-9]+]] = arith.select %[[V_61]], %c0{{.*}}, %[[V_60]] : i64
- ! CHECK: %[[V_63:[0-9]+]] = arith.cmpi ne, %[[V_62]], %c2047{{.*}} : i64
- ! CHECK: %[[V_64:[0-9]+]] = fir.convert %[[V_63]] : (i1) -> !fir.logical<4>
- ! CHECK: %[[V_65:[0-9]+]] = fir.convert %[[V_64]] : (!fir.logical<4>) -> i1
+ ! CHECK: %[[V_32:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
+ ! CHECK: %[[V_33:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
+ ! CHECK: %[[V_34:[0-9]+]] = arith.addf %[[V_32]], %[[V_33]] {{.*}} : f64
+ ! CHECK: %[[V_35:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_34]]) <{bit = 504 : i32}> : (f64) -> i1
+ ! CHECK: %[[V_36:[0-9]+]] = fir.convert %[[V_35]] : (i1) -> !fir.logical<4>
+ ! CHECK: %[[V_37:[0-9]+]] = fir.convert %[[V_36]] : (!fir.logical<4>) -> i1
+ ! CHECK: %[[V_38:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_37]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
print*, ieee_is_finite(y+y)
end subroutine is_finite_test
+! CHECK-LABEL: c.func @_QQmain
real(4) x
real(8) y
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca f64 {adapt.valuebyref}
+ ! CHECK: %[[V_1:[0-9]+]] = fir.alloca f32 {adapt.valuebyref}
+ ! CHECK: %cst = arith.constant 3.40282347E+38 : f32
+ ! CHECK: fir.store %cst to %[[V_1]] : !fir.ref<f32>
+ ! CHECK: %cst_0 = arith.constant 1.7976931348623157E+308 : f64
+ ! CHECK: fir.store %cst_0 to %[[V_0]] : !fir.ref<f64>
+ ! CHECK: fir.call @_QPis_finite_test(%[[V_1]], %[[V_0]]) {{.*}} : (!fir.ref<f32>, !fir.ref<f64>) -> ()
call is_finite_test(huge(x), huge(y))
end
diff --git a/flang/test/Lower/Intrinsics/ieee_operator_eq.f90 b/flang/test/Lower/Intrinsics/ieee_operator_eq.f90
index 01f65c7e54b976..4c2f7271cd2280 100644
--- a/flang/test/Lower/Intrinsics/ieee_operator_eq.f90
+++ b/flang/test/Lower/Intrinsics/ieee_operator_eq.f90
@@ -1,20 +1,23 @@
-! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
-! CHECK-LABEL: @_QPs
+! CHECK-LABEL: c.func @_QPs
subroutine s(r1,r2)
use ieee_arithmetic, only: ieee_round_type, operator(==)
type(ieee_round_type) :: r1, r2
! CHECK: %[[V_3:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
! CHECK: %[[V_4:[0-9]+]] = fir.coordinate_of %arg0, %[[V_3]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
- ! CHECK: %[[V_5:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<i8>
- ! CHECK: %[[V_6:[0-9]+]] = fir.coordinate_of %arg1, %[[V_3]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
- ! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_6]] : !fir.ref<i8>
- ! CHECK: %[[V_8:[0-9]+]] = arith.cmpi eq, %[[V_5]], %[[V_7]] : i8
- ! CHECK: %[[V_9:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_8]]) {{.*}}: (!fir.ref<i8>, i1) -> i1
+ ! CHECK: %[[V_5:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_6:[0-9]+]] = fir.coordinate_of %arg1, %[[V_5]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<i8>
+ ! CHECK: %[[V_8:[0-9]+]] = fir.load %[[V_6]] : !fir.ref<i8>
+ ! CHECK: %[[V_9:[0-9]+]] = arith.cmpi eq, %[[V_7]], %[[V_8]] : i8
+ ! CHECK: %[[V_10:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}} %[[V_9]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+ ! CHECK: return
+ ! CHECK: }
print*, r1 == r2
end
-! CHECK-LABEL: @_QQmain
+! CHECK-LABEL: c.func @_QQmain
use ieee_arithmetic, only: ieee_round_type, ieee_nearest, ieee_to_zero
interface
subroutine s(r1,r2)
@@ -22,25 +25,27 @@ subroutine s(r1,r2)
type(ieee_round_type) :: r1, r2
end
end interface
+
! CHECK: %[[V_0:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
! CHECK: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
! CHECK: %[[V_2:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
! CHECK: %[[V_3:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
- ! CHECK: %[[V_4:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
- ! CHECK: %[[V_5:[0-9]+]] = fir.coordinate_of %[[V_3]], %[[V_4]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
- ! CHECK: fir.store %c2{{.*}} to %[[V_5]] : !fir.ref<i8>
- ! CHECK: %[[V_6:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
- ! CHECK: %[[V_7:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_6]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
- ! CHECK: fir.store %c1{{.*}} to %[[V_7]] : !fir.ref<i8>
+ ! CHECK: %[[V_9:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_10:[0-9]+]] = fir.coordinate_of %[[V_3]], %[[V_9]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c0{{.*}} to %[[V_10]] : !fir.ref<i8>
+ ! CHECK: %[[V_16:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_17:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_16]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c1{{.*}} to %[[V_17]] : !fir.ref<i8>
+ ! CHECK: fir.call @_QPs(%[[V_3]], %[[V_2]]) {{.*}} : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>) -> ()
call s(ieee_to_zero, ieee_nearest)
- ! CHECK: fir.call @_QPs(%[[V_3]], %[[V_2]]) {{.*}}: (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>) -> ()
- ! CHECK: %[[V_8:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
- ! CHECK: %[[V_9:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_8]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
- ! CHECK: fir.store %c1{{.*}} to %[[V_9]] : !fir.ref<i8>
- ! CHECK: %[[V_10:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
- ! CHECK: %[[V_11:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_10]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
- ! CHECK: fir.store %c1{{.*}} to %[[V_11]] : !fir.ref<i8>
- ! CHECK: fir.call @_QPs(%[[V_1]], %[[V_0]]) {{.*}}: (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>) -> ()
+ ! CHECK: %[[V_23:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_24:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_23]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c1{{.*}} to %[[V_24]] : !fir.ref<i8>
+ ! CHECK: %[[V_30:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_31:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_30]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c1{{.*}} to %[[V_31]] : !fir.ref<i8>
+ ! CHECK: fir.call @_QPs(%[[V_1]], %[[V_0]]) {{.*}} : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>) -> ()
call s(ieee_nearest, ieee_nearest)
end
+
diff --git a/flang/test/Lower/Intrinsics/ieee_rounding.f90 b/flang/test/Lower/Intrinsics/ieee_rounding.f90
new file mode 100644
index 00000000000000..79b6786b7a4d48
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_rounding.f90
@@ -0,0 +1,49 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+program r
+ use ieee_arithmetic
+ ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK-DAG: %[[V_2:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}> {bindc_name = "round_value", uniq_name = "_QFEround_value"}
+ type(ieee_round_type) :: round_value
+
+ ! CHECK: %[[V_13:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_13]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c3{{.*}} to %[[V_14]] : !fir.ref<i8>
+ ! CHECK: %[[V_15:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_16:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_15]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_17:[0-9]+]] = fir.load %[[V_16]] : !fir.ref<i8>
+ ! CHECK: %[[V_18:[0-9]+]] = arith.cmpi sge, %[[V_17]], %c0{{.*}} : i8
+ ! CHECK: %[[V_19:[0-9]+]] = arith.cmpi sle, %[[V_17]], %c3{{.*}} : i8
+ ! CHECK: %[[V_20:[0-9]+]] = arith.andi %[[V_18]], %[[V_19]] : i1
+ ! CHECK: %[[V_21:[0-9]+]] = fir.convert %[[V_20]] : (i1) -> !fir.logical<4>
+ ! CHECK: %[[V_22:[0-9]+]] = fir.convert %[[V_21]] : (!fir.logical<4>) -> i1
+ ! CHECK: fir.if %[[V_22]] {
+ if (ieee_support_rounding(ieee_down)) then
+ ! CHECK: %[[V_23:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_24:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_23]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_25:[0-9]+]] = fir.call @llvm.get.rounding() {{.*}} : () -> i32
+ ! CHECK: %[[V_26:[0-9]+]] = fir.convert %[[V_25]] : (i32) -> i8
+ ! CHECK: fir.store %[[V_26]] to %[[V_24]] : !fir.ref<i8>
+ call ieee_get_rounding_mode(round_value)
+
+ ! CHECK: %[[V_32:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_33:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_32]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: fir.store %c3{{.*}} to %[[V_33]] : !fir.ref<i8>
+ ! CHECK: %[[V_34:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_35:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_34]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_36:[0-9]+]] = fir.load %[[V_35]] : !fir.ref<i8>
+ ! CHECK: %[[V_37:[0-9]+]] = fir.convert %[[V_36]] : (i8) -> i32
+ ! CHECK: fir.call @llvm.set.rounding(%[[V_37]]) {{.*}} : (i32) -> ()
+ call ieee_set_rounding_mode(ieee_down)
+ print*, 'ok'
+
+ ! CHECK: %[[V_46:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+ ! CHECK: %[[V_47:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_46]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_48:[0-9]+]] = fir.load %[[V_47]] : !fir.ref<i8>
+ ! CHECK: %[[V_49:[0-9]+]] = fir.convert %[[V_48]] : (i8) -> i32
+ ! CHECK: fir.call @llvm.set.rounding(%[[V_49]]) {{.*}} : (i32) -> ()
+ call ieee_set_rounding_mode(round_value)
+ endif
+end
diff --git a/flang/test/Lower/Intrinsics/ieee_signbit.f90 b/flang/test/Lower/Intrinsics/ieee_signbit.f90
new file mode 100644
index 00000000000000..aa02538a11f243
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_signbit.f90
@@ -0,0 +1,24 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+use ieee_arithmetic
+! CHECK: %[[V_0:[0-9]+]] = fir.alloca f32 {bindc_name = "x", uniq_name = "_QFEx"}
+! CHECK: %cst = arith.constant -2.000000e+00 : f32
+! CHECK: fir.store %cst to %[[V_0]] : !fir.ref<f32>
+x = -2.0
+
+! CHECK: %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<f32>
+! CHECK: %[[V_5:[0-9]+]] = arith.bitcast %[[V_4]] : f32 to i32
+! CHECK: %[[V_6:[0-9]+]] = arith.shrui %[[V_5]], %c31{{.*}} : i32
+! CHECK: %[[V_7:[0-9]+]] = fir.convert %[[V_6]] : (i32) -> !fir.logical<4>
+! CHECK: %[[V_8:[0-9]+]] = fir.convert %[[V_7]] : (!fir.logical<4>) -> i1
+! CHECK: %[[V_9:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_8]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+
+! CHECK: %cst_0 = arith.constant 1.700000e+01 : f32
+! CHECK: %[[V_10:[0-9]+]] = arith.bitcast %cst_0 : f32 to i32
+! CHECK: %[[V_11:[0-9]+]] = arith.shrui %[[V_10]], %c31{{.*}} : i32
+! CHECK: %[[V_12:[0-9]+]] = fir.convert %[[V_11]] : (i32) -> !fir.logical<4>
+! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_12]] : (!fir.logical<4>) -> i1
+! CHECK: %[[V_14:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_13]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+print*, ieee_signbit(x), ieee_signbit(17.0)
+end
diff --git a/flang/test/Lower/Intrinsics/ieee_unordered.f90 b/flang/test/Lower/Intrinsics/ieee_unordered.f90
new file mode 100644
index 00000000000000..58b827348bfe03
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_unordered.f90
@@ -0,0 +1,72 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: func @_QQmain
+use ieee_arithmetic
+! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK-DAG: %[[V_2:[0-9]+]] = fir.alloca f128 {bindc_name = "x", uniq_name = "_QFEx"}
+! CHECK-DAG: %[[V_3:[0-9]+]] = fir.alloca f128 {bindc_name = "y", uniq_name = "_QFEy"}
+! CHECK-DAG: %[[V_4:[0-9]+]] = fir.alloca f128 {bindc_name = "z", uniq_name = "_QFEz"}
+real(16) :: x, y, z
+
+x = -17.0
+
+! CHECK: %[[V_10:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK: %[[V_11:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_10]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+! CHECK: fir.store %c3{{.*}} to %[[V_11]] : !fir.ref<i8>
+
+! CHECK: %[[V_12:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK: %[[V_13:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_12]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+! CHECK: %[[V_14:[0-9]+]] = fir.load %[[V_13]] : !fir.ref<i8>
+! CHECK: %[[V_15:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref<!fir.array<12xi64>>
+! CHECK: %[[V_16:[0-9]+]] = fir.coordinate_of %[[V_15]], %[[V_14]] : (!fir.ref<!fir.array<12xi64>>, i8) -> !fir.ref<i64>
+! CHECK: %[[V_17:[0-9]+]] = fir.load %[[V_16]] : !fir.ref<i64>
+! CHECK: %[[V_18:[0-9]+]] = fir.convert %[[V_17]] : (i64) -> i128
+! CHECK: %[[V_19:[0-9]+]] = arith.shli %[[V_18]], %c64{{.*}} : i128
+! CHECK: %[[V_20:[0-9]+]] = arith.bitcast %[[V_19]] : i128 to f128
+! CHECK: fir.store %[[V_20]] to %[[V_3]] : !fir.ref<f128>
+y = ieee_value(y, ieee_negative_inf)
+
+! CHECK: %[[V_26:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK: %[[V_27:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_26]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+! CHECK: fir.store %c2{{.*}} to %[[V_27]] : !fir.ref<i8>
+! CHECK: %[[V_28:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK: %[[V_29:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_28]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+! CHECK: %[[V_30:[0-9]+]] = fir.load %[[V_29]] : !fir.ref<i8>
+! CHECK: %[[V_31:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref<!fir.array<12xi64>>
+! CHECK: %[[V_32:[0-9]+]] = fir.coordinate_of %[[V_31]], %[[V_30]] : (!fir.ref<!fir.array<12xi64>>, i8) -> !fir.ref<i64>
+! CHECK: %[[V_33:[0-9]+]] = fir.load %[[V_32]] : !fir.ref<i64>
+! CHECK: %[[V_34:[0-9]+]] = fir.convert %[[V_33]] : (i64) -> i128
+! CHECK: %[[V_35:[0-9]+]] = arith.shli %[[V_34]], %c64{{.*}} : i128
+! CHECK: %[[V_36:[0-9]+]] = arith.bitcast %[[V_35]] : i128 to f128
+! CHECK: fir.store %[[V_36]] to %[[V_4]] : !fir.ref<f128>
+z = ieee_value(z, ieee_quiet_nan)
+
+! CHECK: %[[V_40:[0-9]+]] = fir.load %[[V_2]] : !fir.ref<f128>
+! CHECK: %[[V_41:[0-9]+]] = fir.load %[[V_3]] : !fir.ref<f128>
+! CHECK: %[[V_42:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_40]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK: %[[V_43:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_41]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK: %[[V_44:[0-9]+]] = arith.ori %[[V_42]], %[[V_43]] : i1
+! CHECK: %[[V_45:[0-9]+]] = fir.convert %[[V_44]] : (i1) -> !fir.logical<4>
+! CHECK: %[[V_46:[0-9]+]] = fir.convert %[[V_45]] : (!fir.logical<4>) -> i1
+! CHECK: %[[V_47:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_46]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+
+! CHECK: %[[V_48:[0-9]+]] = fir.load %[[V_2]] : !fir.ref<f128>
+! CHECK: %[[V_49:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<f128>
+! CHECK: %[[V_50:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_48]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK: %[[V_51:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_49]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK: %[[V_52:[0-9]+]] = arith.ori %[[V_50]], %[[V_51]] : i1
+! CHECK: %[[V_53:[0-9]+]] = fir.convert %[[V_52]] : (i1) -> !fir.logical<4>
+! CHECK: %[[V_54:[0-9]+]] = fir.convert %[[V_53]] : (!fir.logical<4>) -> i1
+! CHECK: %[[V_55:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_54]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+
+! CHECK: %[[V_56:[0-9]+]] = fir.load %[[V_3]] : !fir.ref<f128>
+! CHECK: %[[V_57:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<f128>
+! CHECK: %[[V_58:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_56]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK: %[[V_59:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_57]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK: %[[V_60:[0-9]+]] = arith.ori %[[V_58]], %[[V_59]] : i1
+! CHECK: %[[V_61:[0-9]+]] = fir.convert %[[V_60]] : (i1) -> !fir.logical<4>
+! CHECK: %[[V_62:[0-9]+]] = fir.convert %[[V_61]] : (!fir.logical<4>) -> i1
+! CHECK: %[[V_63:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_62]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+print*, ieee_unordered(x,y), ieee_unordered(x,z), ieee_unordered(y,z)
+end
More information about the flang-commits
mailing list