From 09ea692d166af42cda43bd24d42a6c67a12cce5a Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Thu, 29 Jun 2023 11:32:56 -0700 Subject: [PATCH] [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. --- flang/include/flang/Lower/PFTBuilder.h | 1 + .../flang/Optimizer/Builder/IntrinsicCall.h | 14 +- .../flang/Optimizer/Builder/LowLevelIntrinsics.h | 6 + flang/include/flang/Runtime/ieee_arithmetic.h | 47 ++ flang/lib/Evaluate/fold-logical.cpp | 11 +- flang/lib/Lower/Bridge.cpp | 13 + flang/lib/Lower/PFTBuilder.cpp | 25 + flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 713 +++++++++++++++++++-- flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp | 18 + flang/module/ieee_arithmetic.f90 | 41 +- flang/test/Lower/Intrinsics/ieee_class.f90 | 142 ++++ flang/test/Lower/Intrinsics/ieee_class_queries.f90 | 55 ++ flang/test/Lower/Intrinsics/ieee_copy_sign.f90 | 51 ++ flang/test/Lower/Intrinsics/ieee_is_finite.f90 | 83 +-- flang/test/Lower/Intrinsics/ieee_operator_eq.f90 | 49 +- flang/test/Lower/Intrinsics/ieee_rounding.f90 | 49 ++ flang/test/Lower/Intrinsics/ieee_signbit.f90 | 24 + flang/test/Lower/Intrinsics/ieee_unordered.f90 | 72 +++ 18 files changed, 1248 insertions(+), 166 deletions(-) create mode 100644 flang/include/flang/Runtime/ieee_arithmetic.h create mode 100644 flang/test/Lower/Intrinsics/ieee_class.f90 create mode 100644 flang/test/Lower/Intrinsics/ieee_class_queries.f90 create mode 100644 flang/test/Lower/Intrinsics/ieee_copy_sign.f90 create mode 100644 flang/test/Lower/Intrinsics/ieee_rounding.f90 create mode 100644 flang/test/Lower/Intrinsics/ieee_signbit.f90 create mode 100644 flang/test/Lower/Intrinsics/ieee_unordered.f90 diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 30d7da7..5927fc1 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 17abfef..b4b82ea 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); fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genFindloc(mlir::Type, llvm::ArrayRef); + mlir::Value genIeeeClass(mlir::Type, llvm::ArrayRef); + mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef); + void genIeeeGetRoundingMode(llvm::ArrayRef); mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef); + mlir::Value genIeeeIsNan(mlir::Type, llvm::ArrayRef); + mlir::Value genIeeeIsNegative(mlir::Type, llvm::ArrayRef); mlir::Value genIeeeIsNormal(mlir::Type, llvm::ArrayRef); + void genIeeeSetRoundingMode(llvm::ArrayRef); + mlir::Value genIeeeSignbit(mlir::Type, llvm::ArrayRef); + mlir::Value genIeeeSupportRounding(mlir::Type, llvm::ArrayRef); template - fir::ExtendedValue genIeeeTypeCompare(mlir::Type, - llvm::ArrayRef); + mlir::Value genIeeeTypeCompare(mlir::Type, llvm::ArrayRef); + mlir::Value genIeeeUnordered(mlir::Type, llvm::ArrayRef); + mlir::Value genIeeeValue(mlir::Type, llvm::ArrayRef); mlir::Value genIeor(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef); mlir::Value genIor(mlir::Type, llvm::ArrayRef); @@ -244,7 +253,6 @@ struct IntrinsicLibrary { llvm::ArrayRef); template mlir::Value genIsIostatValue(mlir::Type, llvm::ArrayRef); - mlir::Value genIsNan(mlir::Type, llvm::ArrayRef); mlir::Value genIsFPClass(mlir::Type, llvm::ArrayRef, int fpclass); mlir::Value genIshft(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h index d59325b..a6dcfe6 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 0000000..7a264fd --- /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 22df42c..e900905 100644 --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -167,10 +167,13 @@ Expr> FoldIntrinsicFunction( } else if (name == "__builtin_ieee_is_negative") { auto restorer{context.messages().DiscardMessages()}; using DefaultReal = Type; - return FoldElementalIntrinsic(context, std::move(funcRef), - ScalarFunc([](const Scalar &x) { - return Scalar{x.IsNegative()}; - })); + if (args[0] && args[0]->UnwrapExpr() && + IsActuallyConstant(*args[0]->UnwrapExpr())) { + return FoldElementalIntrinsic(context, std::move(funcRef), + ScalarFunc([](const Scalar &x) { + return Scalar{x.IsNegative()}; + })); + } } else if (name == "__builtin_ieee_is_normal") { auto restorer{context.messages().DiscardMessages()}; using DefaultReal = Type; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 211d496..087d3203 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -3958,6 +3958,19 @@ private: 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(toLocation(), getRound).getResult(0); + mlir::Location endLoc = + toLocation(Fortran::lower::pft::stmtSourceLoc(funit.endStmt)); + bridge.fctCtx().attachCleanup( + [=]() { builder->create(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 1530e9e..97afdaf 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -105,6 +105,13 @@ public: } else if constexpr (std::is_same_v) { return std::visit( common::visitors{ + [&](const common::Indirection &x) { + addEvaluation(lower::pft::Evaluation{ + removeIndirection(x), pftParentStack.back(), + stmt.position, stmt.label}); + checkForRoundingModeCall(x.value()); + return true; + }, [&](const common::Indirection &x) { convertIfStmt(x.value(), stmt.position, stmt.label); return false; @@ -122,6 +129,24 @@ public: 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(callStmt.call.t); + const auto *callName = std::get_if(&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 2f3722d..f5df115 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}, {"ieee_class_ne", &I::genIeeeTypeCompare}, + {"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}, {"ieee_round_ne", &I::genIeeeTypeCompare}, + {"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}, {"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(loc, resultType, code); } +// Return a reference to the contents of a derived type with one field. +// Also return the field type. +static std::pair +getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec) { + auto recType = + fir::unwrapPassByRefType(rec.getType()).dyn_cast(); + assert(recType.getTypeList().size() == 1 && "expected exactly one component"); + auto [fieldName, fieldTy] = recType.getTypeList().front(); + mlir::Value field = builder.create( + loc, fir::FieldType::get(recType.getContext()), fieldName, recType, + fir::getTypeParams(rec)); + return {builder.create(loc, builder.getRefType(fieldTy), + rec, field), + fieldTy}; +} + // IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=) // IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=) template -fir::ExtendedValue +mlir::Value IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType, - llvm::ArrayRef args) { + llvm::ArrayRef 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(); - 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( - loc, fieldIndexType, fieldName, recType, fir::getTypeParams(arg0)); - mlir::Value left = builder.create( - loc, fieldType, - builder.create(loc, builder.getRefType(fieldType), - arg0, field)); - mlir::Value right = builder.create( - loc, fieldType, - builder.create(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(loc, fieldTy, leftRef); + mlir::Value right = builder.create(loc, fieldTy, rightRef); return builder.create(loc, pred, left, right); } +// IEEE_CLASS +mlir::Value IntrinsicLibrary::genIeeeClass(mlir::Type resultType, + llvm::ArrayRef 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::Type intType = builder.getIntegerType(realType.getWidth()); + mlir::Value intVal = + builder.create(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(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(loc, lowSignificandMask, sixtyfour); + lowSignificandMask = + builder.create(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( + loc, builder.create(loc, intVal, signShift), + createIntegerConstant(1 << pos)); + + // [e] exponent != 0 + mlir::Value exponent = + builder.create(loc, intVal, exponentMask); + mlir::Value zero = createIntegerConstant(0); + index = builder.create( + loc, index, + builder.create( + loc, + builder.create( + loc, mlir::arith::CmpIPredicate::ne, exponent, zero), + createIntegerConstant(1 << --pos), zero)); + + // [m] exponent == 1..1 (max exponent) + index = builder.create( + loc, index, + builder.create( + loc, + builder.create( + loc, mlir::arith::CmpIPredicate::eq, exponent, exponentMask), + createIntegerConstant(1 << --pos), zero)); + + // [l] low-order significand != 0 + index = builder.create( + loc, index, + builder.create( + loc, + builder.create( + loc, mlir::arith::CmpIPredicate::ne, + builder.create(loc, intVal, + lowSignificandMask), + zero), + createIntegerConstant(1 << --pos), zero)); + + // [h] high-order significand (1 or 2 bits) + index = builder.create( + loc, index, + builder.create( + loc, + builder.create(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 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( + loc, builder.getRefType(resultType), + builder.create(loc, builder.getRefType(tableTy), + builder.getSymbolRefAttr(tableName)), + index); +} + +// IEEE_COPY_SIGN +mlir::Value +IntrinsicLibrary::genIeeeCopySign(mlir::Type resultType, + llvm::ArrayRef 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 yRealType = yRealVal.getType().dyn_cast(); + + 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(loc, xRealVal, yRealVal); + + // Args have different types. + mlir::Type xIntType = builder.getIntegerType(xRealType.getWidth()); + mlir::Type yIntType = builder.getIntegerType(yRealType.getWidth()); + mlir::Value xIntVal = + builder.create(loc, xIntType, xRealVal); + mlir::Value yIntVal = + builder.create(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( + loc, yIntVal, + builder.createIntegerConstant(loc, yIntType, yRealType.getWidth() - 1)); + mlir::Value xAbs = builder.create( + loc, builder.create(loc, xIntVal, xOne), xOne); + mlir::Value xSign = builder.create( + loc, + builder.create(loc, mlir::arith::CmpIPredicate::eq, + ySign, yZero), + xZero, + builder.create( + loc, xOne, + builder.createIntegerConstant(loc, xIntType, + xRealType.getWidth() - 1))); + return builder.create( + loc, xRealType, builder.create(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( + loc, mlir::arith::CmpIPredicate::ne, radix, + builder.createIntegerConstant(loc, radix.getType(), 2)); + auto ifOp = builder.create(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 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(loc, getRound).getResult(0); + mode = builder.createConvert(loc, fieldTy, mode); + builder.create(loc, mode, fieldRef); +} + +mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType, + llvm::ArrayRef args, + int fpclass) { + assert(args.size() == 1); + mlir::Type i1Ty = builder.getI1Type(); + mlir::Value isfpclass = + builder.create(loc, i1Ty, args[0], fpclass); + return builder.createConvert(loc, resultType, isfpclass); +} + // IEEE_IS_FINITE mlir::Value IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType, llvm::ArrayRef 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(); - int floatBits = floatType.getWidth(); - mlir::Type intType = builder.getIntegerType( - floatType.isa() ? 128 : floatBits); - mlir::Value intVal = - builder.create(loc, intType, floatVal); - int significandBits; - if (floatType.isa()) - significandBits = 23; - else if (floatType.isa()) - 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(loc, mlir::arith::CmpIPredicate::ne, - exponent, maxExponent)); + return genIsFPClass(resultType, args, 0b0111111000); +} + +// IEEE_IS_NAN +mlir::Value IntrinsicLibrary::genIeeeIsNan(mlir::Type resultType, + llvm::ArrayRef 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 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 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 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(loc, fieldRef); + mode = builder.create( + loc, setRound.getFunctionType().getInput(0), mode); + builder.create(loc, setRound, mode); +} + +// IEEE_SIGNBIT +mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType, + llvm::ArrayRef 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(); + 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(loc, intType, realVal); + mlir::Value shift = builder.createIntegerConstant(loc, intType, bitWidth - 1); + mlir::Value sign = builder.create(loc, intVal, shift); + return builder.createConvert(loc, resultType, sign); +} + +// IEEE_SUPPORT_ROUNDING +mlir::Value +IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType, + llvm::ArrayRef 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(loc, fieldRef); + mlir::Value lbOk = builder.create( + loc, mlir::arith::CmpIPredicate::sge, mode, + builder.createIntegerConstant(loc, fieldTy, + _FORTRAN_RUNTIME_IEEE_TO_ZERO)); + mlir::Value ubOk = builder.create( + loc, mlir::arith::CmpIPredicate::sle, mode, + builder.createIntegerConstant(loc, fieldTy, _FORTRAN_RUNTIME_IEEE_DOWN)); + return builder.createConvert( + loc, resultType, builder.create(loc, lbOk, ubOk)); +} + +// IEEE_UNORDERED +mlir::Value +IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType, + llvm::ArrayRef 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(loc, xIsNan, yIsNan); + return builder.createConvert(loc, resultType, res); +} + +// IEEE_VALUE +mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType, + llvm::ArrayRef 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(); + 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 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(loc, fieldRef); + mlir::Value bits = builder.create( + loc, + builder.create( + loc, builder.getRefType(valueTy), + builder.create(loc, builder.getRefType(tableTy), + builder.getSymbolRefAttr(tableName)), + which)); + if (bitWidth > 64) + bits = builder.create( + loc, builder.createConvert(loc, intType, bits), + builder.createIntegerConstant(loc, intType, bitWidth - 64)); + return builder.create(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 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(loc, i1ty, args[0], fpclass); - return builder.createConvert(loc, resultType, isfpclass); -} - -mlir::Value IntrinsicLibrary::genIsNan(mlir::Type resultType, - llvm::ArrayRef args) { - // Check is signaling or quiet nan - return genIsFPClass(resultType, args, 0b11); -} - // ISHFT mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType, llvm::ArrayRef 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 eea4385..5d6edf8 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 64a5b25..36792ed 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 0000000..b003284 --- /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 + ! 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> + ! CHECK: %[[V_27:[0-9]+]] = fir.coordinate_of %[[V_26]], %[[V_25]] : (!fir.ref>, i64) -> !fir.ref> + ! 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.field) -> !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: %[[V_32:[0-9]+]] = fir.load %[[V_29]] : !fir.ref + ! CHECK: fir.store %[[V_32]] to %[[V_31]] : !fir.ref + 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.field) -> !fir.ref + ! CHECK: fir.store %c3{{.*}} to %[[V_39]] : !fir.ref + ! 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.field) -> !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: %[[V_44:[0-9]+]] = fir.load %[[V_41]] : !fir.ref + ! CHECK: %[[V_45:[0-9]+]] = fir.load %[[V_43]] : !fir.ref + ! 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 + ! CHECK: fir.call @_QMmPout(%arg0, %[[V_0]]) {{.*}} : (!fir.ref, !fir.ref) -> () + ! 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> + ! 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.field) -> !fir.ref + ! CHECK: fir.store %c3{{.*}} to %[[V_9]] : !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_11]] : !fir.ref + ! CHECK: %[[V_13:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_8) : !fir.ref> + ! CHECK: %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_13]], %[[V_12]] : (!fir.ref>, i8) -> !fir.ref + ! CHECK: %[[V_15:[0-9]+]] = fir.load %[[V_14]] : !fir.ref + ! 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>, i64) -> !fir.ref + ! CHECK: fir.store %[[V_16]] to %[[V_18]] : !fir.ref + 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 0000000..ac5904c --- /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 0000000..61005f6 --- /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 + ! CHECK: %[[V_3:[0-9]+]] = fir.address_of(@_QFEx4) : !fir.ref + ! CHECK: %[[V_4:[0-9]+]] = fir.address_of(@_QFEy4) : !fir.ref + 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 + ! CHECK: %[[V_9:[0-9]+]] = fir.load %[[V_4]] : !fir.ref + ! 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, f32) -> i1 + print*, ieee_copy_sign(x4, y4) + + ! CHECK: %[[V_16:[0-9]+]] = fir.load %[[V_2]] : !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: fir.store %c2{{.*}} to %[[V_23]] : !fir.ref + + ! 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.field) -> !fir.ref + ! CHECK: %[[V_26:[0-9]+]] = fir.load %[[V_25]] : !fir.ref + ! CHECK: %[[V_27:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref> + ! CHECK: %[[V_28:[0-9]+]] = fir.coordinate_of %[[V_27]], %[[V_26]] : (!fir.ref>, i8) -> !fir.ref + ! CHECK: %[[V_29:[0-9]+]] = fir.load %[[V_28]] : !fir.ref + ! 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 + 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 69d1b69..db226c0 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 - ! 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 + ! 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, i1) -> i1 print*, ieee_is_finite(x) - ! CHECK: %[[V_19:[0-9]+]] = fir.load %arg0 : !fir.ref - ! CHECK: %[[V_20:[0-9]+]] = fir.load %arg0 : !fir.ref - ! 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 + ! CHECK: %[[V_13:[0-9]+]] = fir.load %arg0 : !fir.ref + ! 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, i1) -> i1 print*, ieee_is_finite(x+x) - ! CHECK: %[[V_37:[0-9]+]] = fir.load %arg1 : !fir.ref - ! 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 + ! 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, i1) -> i1 print*, ieee_is_finite(y) - ! CHECK: %[[V_53:[0-9]+]] = fir.load %arg1 : !fir.ref - ! CHECK: %[[V_54:[0-9]+]] = fir.load %arg1 : !fir.ref - ! 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 + ! CHECK: %[[V_33:[0-9]+]] = fir.load %arg1 : !fir.ref + ! 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, 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 + ! CHECK: %cst_0 = arith.constant 1.7976931348623157E+308 : f64 + ! CHECK: fir.store %cst_0 to %[[V_0]] : !fir.ref + ! CHECK: fir.call @_QPis_finite_test(%[[V_1]], %[[V_0]]) {{.*}} : (!fir.ref, !fir.ref) -> () 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 01f65c7..4c2f727 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.field) -> !fir.ref - ! CHECK: %[[V_5:[0-9]+]] = fir.load %[[V_4]] : !fir.ref - ! CHECK: %[[V_6:[0-9]+]] = fir.coordinate_of %arg1, %[[V_3]] : (!fir.ref>, !fir.field) -> !fir.ref - ! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_6]] : !fir.ref - ! 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, 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.field) -> !fir.ref + ! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_4]] : !fir.ref + ! CHECK: %[[V_8:[0-9]+]] = fir.load %[[V_6]] : !fir.ref + ! 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, 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 @@ end 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.field) -> !fir.ref - ! CHECK: fir.store %c2{{.*}} to %[[V_5]] : !fir.ref - ! 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.field) -> !fir.ref - ! CHECK: fir.store %c1{{.*}} to %[[V_7]] : !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: fir.store %c0{{.*}} to %[[V_10]] : !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: fir.store %c1{{.*}} to %[[V_17]] : !fir.ref + ! CHECK: fir.call @_QPs(%[[V_3]], %[[V_2]]) {{.*}} : (!fir.ref>, !fir.ref>) -> () call s(ieee_to_zero, ieee_nearest) - ! CHECK: fir.call @_QPs(%[[V_3]], %[[V_2]]) {{.*}}: (!fir.ref>, !fir.ref>) -> () - ! 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.field) -> !fir.ref - ! CHECK: fir.store %c1{{.*}} to %[[V_9]] : !fir.ref - ! 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.field) -> !fir.ref - ! CHECK: fir.store %c1{{.*}} to %[[V_11]] : !fir.ref - ! CHECK: fir.call @_QPs(%[[V_1]], %[[V_0]]) {{.*}}: (!fir.ref>, !fir.ref>) -> () + ! 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.field) -> !fir.ref + ! CHECK: fir.store %c1{{.*}} to %[[V_24]] : !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: fir.store %c1{{.*}} to %[[V_31]] : !fir.ref + ! CHECK: fir.call @_QPs(%[[V_1]], %[[V_0]]) {{.*}} : (!fir.ref>, !fir.ref>) -> () 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 0000000..79b6786 --- /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.field) -> !fir.ref + ! CHECK: fir.store %c3{{.*}} to %[[V_14]] : !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: %[[V_17:[0-9]+]] = fir.load %[[V_16]] : !fir.ref + ! 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.field) -> !fir.ref + ! 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 + 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.field) -> !fir.ref + ! CHECK: fir.store %c3{{.*}} to %[[V_33]] : !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: %[[V_36:[0-9]+]] = fir.load %[[V_35]] : !fir.ref + ! 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.field) -> !fir.ref + ! CHECK: %[[V_48:[0-9]+]] = fir.load %[[V_47]] : !fir.ref + ! 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 0000000..aa02538 --- /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 +x = -2.0 + +! CHECK: %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref +! 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, 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, 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 0000000..58b8273 --- /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.field) -> !fir.ref +! CHECK: fir.store %c3{{.*}} to %[[V_11]] : !fir.ref + +! 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.field) -> !fir.ref +! CHECK: %[[V_14:[0-9]+]] = fir.load %[[V_13]] : !fir.ref +! CHECK: %[[V_15:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref> +! CHECK: %[[V_16:[0-9]+]] = fir.coordinate_of %[[V_15]], %[[V_14]] : (!fir.ref>, i8) -> !fir.ref +! CHECK: %[[V_17:[0-9]+]] = fir.load %[[V_16]] : !fir.ref +! 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 +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.field) -> !fir.ref +! CHECK: fir.store %c2{{.*}} to %[[V_27]] : !fir.ref +! 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.field) -> !fir.ref +! CHECK: %[[V_30:[0-9]+]] = fir.load %[[V_29]] : !fir.ref +! CHECK: %[[V_31:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref> +! CHECK: %[[V_32:[0-9]+]] = fir.coordinate_of %[[V_31]], %[[V_30]] : (!fir.ref>, i8) -> !fir.ref +! CHECK: %[[V_33:[0-9]+]] = fir.load %[[V_32]] : !fir.ref +! 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 +z = ieee_value(z, ieee_quiet_nan) + +! CHECK: %[[V_40:[0-9]+]] = fir.load %[[V_2]] : !fir.ref +! CHECK: %[[V_41:[0-9]+]] = fir.load %[[V_3]] : !fir.ref +! 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, i1) -> i1 + +! CHECK: %[[V_48:[0-9]+]] = fir.load %[[V_2]] : !fir.ref +! CHECK: %[[V_49:[0-9]+]] = fir.load %[[V_4]] : !fir.ref +! 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, i1) -> i1 + +! CHECK: %[[V_56:[0-9]+]] = fir.load %[[V_3]] : !fir.ref +! CHECK: %[[V_57:[0-9]+]] = fir.load %[[V_4]] : !fir.ref +! 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, i1) -> i1 +print*, ieee_unordered(x,y), ieee_unordered(x,z), ieee_unordered(y,z) +end -- 2.7.4