[flang-commits] [flang] 124338d - [flang] Increase support for intrinsic module procedures
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Thu Jun 23 09:04:14 PDT 2022
Author: Val Donaldson
Date: 2022-06-23T18:03:48+02:00
New Revision: 124338dd8016dc7589685d9fc731b178f2b5d379
URL: https://github.com/llvm/llvm-project/commit/124338dd8016dc7589685d9fc731b178f2b5d379
DIFF: https://github.com/llvm/llvm-project/commit/124338dd8016dc7589685d9fc731b178f2b5d379.diff
LOG: [flang] Increase support for intrinsic module procedures
* Make Semantics test doconcurrent01.f90 an expected failure pending a fix
for a problem in recognizing a PURE prefix specifier for a specific procedure
that occurs in new intrinsic module source code,
* review update
* review update
* Increase support for intrinsic module procedures
The f18 standard defines 5 intrinsic modules that define varying numbers
of procedures, including several operators:
2 iso_fortran_env
55 ieee_arithmetic
10 ieee_exceptions
0 ieee_features
6 iso_c_binding
There are existing fortran source files for each of these intrinsic modules.
This PR adds generic procedure declarations to these files for procedures
that do not already have them, together with associated specific procedure
declarations. It also adds the capability of recognizing intrinsic module
procedures in lowering code, making it possible to use existing language
intrinsic code generation for intrinsic module procedures for both scalar
and elemental calls. Code can then be generated for intrinsic module
procedures using existing options, including front end folding, direct
inlining, and calls to runtime support routines. Detailed code generation
is provided for several procedures in this PR, with others left to future PRs.
Procedure calls that reach lowering and don't have detailed implementation
support will generate a "not yet implemented" message with a recognizable name.
The generic procedures in these modules may each have as many as 36 specific
procedures. Most specific procedures are generated via macros that generate
type specific interface declarations. These specific declarations provide
detailed argument information for each individual procedure call, similar
to what is done via other means for standard language intrinsics. The
modules only provide interface declarations. There are no procedure
definitions, again in keeping with how language intrinsics are processed.
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: jeanPerier, PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D128431
Co-authored-by: V Donaldson <vdonaldson at nvidia.com>
Added:
flang/test/Lower/intrinsic-procedures/ieee_is_finite.f90
flang/test/Lower/intrinsic-procedures/ieee_operator_eq.f90
Modified:
flang/include/flang/Lower/IntrinsicCall.h
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/IntrinsicCall.cpp
flang/module/__fortran_ieee_exceptions.f90
flang/module/ieee_arithmetic.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h
index 2267e2c225798..0846c6d38c431 100644
--- a/flang/include/flang/Lower/IntrinsicCall.h
+++ b/flang/include/flang/Lower/IntrinsicCall.h
@@ -75,9 +75,8 @@ getIntrinsicArgumentLowering(llvm::StringRef intrinsicName);
/// Return how argument \p argName should be lowered given the rules for the
/// intrinsic function. The argument names are the one defined by the standard.
-ArgLoweringRule lowerIntrinsicArgumentAs(mlir::Location,
- const IntrinsicArgumentLoweringRules &,
- llvm::StringRef argName);
+ArgLoweringRule lowerIntrinsicArgumentAs(const IntrinsicArgumentLoweringRules &,
+ unsigned position);
/// Return place-holder for absent intrinsic arguments.
fir::ExtendedValue getAbsentIntrinsicArgument();
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index caffe753800a6..92d379d3e317a 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -571,6 +571,16 @@ const Fortran::semantics::Symbol &getLastSym(const A &obj) {
return obj.GetLastSymbol().GetUltimate();
}
+static bool
+isIntrinsicModuleProcRef(const Fortran::evaluate::ProcedureRef &procRef) {
+ const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
+ if (!symbol)
+ return false;
+ const Fortran::semantics::Symbol *module =
+ symbol->GetUltimate().owner().GetSymbol();
+ return module && module->attrs().test(Fortran::semantics::Attr::INTRINSIC);
+}
+
namespace {
/// Lowering of Fortran::evaluate::Expr<T> expressions
@@ -2099,17 +2109,20 @@ class ScalarExprLowering {
fir::factory::getNonDeferredLengthParams(exv));
}
- /// Generate a call to an intrinsic function.
- ExtValue
- genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef,
- const Fortran::evaluate::SpecificIntrinsic &intrinsic,
- llvm::Optional<mlir::Type> resultType) {
+ /// Generate a call to a Fortran intrinsic or intrinsic module procedure.
+ ExtValue genIntrinsicRef(
+ const Fortran::evaluate::ProcedureRef &procRef,
+ llvm::Optional<mlir::Type> resultType,
+ llvm::Optional<const Fortran::evaluate::SpecificIntrinsic> intrinsic =
+ llvm::None) {
llvm::SmallVector<ExtValue> operands;
- llvm::StringRef name = intrinsic.name;
+ std::string name =
+ intrinsic ? intrinsic->name
+ : procRef.proc().GetSymbol()->GetUltimate().name().ToString();
mlir::Location loc = getLoc();
- if (Fortran::lower::intrinsicRequiresCustomOptionalHandling(
- procRef, intrinsic, converter)) {
+ if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
+ procRef, *intrinsic, converter)) {
using ExvAndPresence = std::pair<ExtValue, llvm::Optional<mlir::Value>>;
llvm::SmallVector<ExvAndPresence, 4> operands;
auto prepareOptionalArg = [&](const Fortran::lower::SomeExpr &expr) {
@@ -2122,7 +2135,7 @@ class ScalarExprLowering {
operands.emplace_back(genval(expr), llvm::None);
};
Fortran::lower::prepareCustomIntrinsicArgument(
- procRef, intrinsic, resultType, prepareOptionalArg, prepareOtherArg,
+ procRef, *intrinsic, resultType, prepareOptionalArg, prepareOtherArg,
converter);
auto getArgument = [&](std::size_t i) -> ExtValue {
@@ -2141,10 +2154,9 @@ class ScalarExprLowering {
const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering =
Fortran::lower::getIntrinsicArgumentLowering(name);
- for (const auto &[arg, dummy] :
- llvm::zip(procRef.arguments(),
- intrinsic.characteristics.value().dummyArguments)) {
- auto *expr = Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg);
+ for (const auto &arg : llvm::enumerate(procRef.arguments())) {
+ auto *expr =
+ Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
if (!expr) {
// Absent optional.
operands.emplace_back(Fortran::lower::getAbsentIntrinsicArgument());
@@ -2157,8 +2169,7 @@ class ScalarExprLowering {
}
// Ad-hoc argument lowering handling.
Fortran::lower::ArgLoweringRule argRules =
- Fortran::lower::lowerIntrinsicArgumentAs(loc, *argLowering,
- dummy.name);
+ Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index());
if (argRules.handleDynamicOptional &&
Fortran::evaluate::MayBePassedAsAbsentOptional(
*expr, converter.getFoldingContext())) {
@@ -2204,13 +2215,6 @@ class ScalarExprLowering {
operands, stmtCtx);
}
- template <typename A>
- bool isCharacterType(const A &exp) {
- if (auto type = exp.GetType())
- return type->category() == Fortran::common::TypeCategory::Character;
- return false;
- }
-
/// helper to detect statement functions
static bool
isStatementFunctionCall(const Fortran::evaluate::ProcedureRef &procRef) {
@@ -2220,6 +2224,7 @@ class ScalarExprLowering {
return details->stmtFunction().has_value();
return false;
}
+
/// Generate Statement function calls
ExtValue genStmtFunctionRef(const Fortran::evaluate::ProcedureRef &procRef) {
const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
@@ -2832,6 +2837,13 @@ class ScalarExprLowering {
Fortran::lower::getAdaptToByRefAttr(builder)});
}
+ template <typename A>
+ bool isCharacterType(const A &exp) {
+ if (auto type = exp.GetType())
+ return type->category() == Fortran::common::TypeCategory::Character;
+ return false;
+ }
+
/// Lower an actual argument that must be passed via an address.
/// This generates of the copy-in/copy-out if the actual is not contiguous, or
/// the creation of the temp if the actual is a variable and \p byValue is
@@ -2930,9 +2942,13 @@ class ScalarExprLowering {
if (isElementalProcWithArrayArgs(procRef))
fir::emitFatalError(loc, "trying to lower elemental procedure with array "
"arguments as normal procedure");
+
if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =
procRef.proc().GetSpecificIntrinsic())
- return genIntrinsicRef(procRef, *intrinsic, resultType);
+ return genIntrinsicRef(procRef, resultType, *intrinsic);
+
+ if (isIntrinsicModuleProcRef(procRef))
+ return genIntrinsicRef(procRef, resultType);
if (isStatementFunctionCall(procRef))
return genStmtFunctionRef(procRef);
@@ -4685,18 +4701,22 @@ class ArrayExprLowering {
return genarr(x);
}
- // A procedure reference to a Fortran elemental intrinsic procedure.
+ // A reference to a Fortran elemental intrinsic or intrinsic module procedure.
CC genElementalIntrinsicProcRef(
const Fortran::evaluate::ProcedureRef &procRef,
llvm::Optional<mlir::Type> retTy,
- const Fortran::evaluate::SpecificIntrinsic &intrinsic) {
+ llvm::Optional<const Fortran::evaluate::SpecificIntrinsic> intrinsic =
+ llvm::None) {
+
llvm::SmallVector<CC> operands;
- llvm::StringRef name = intrinsic.name;
+ std::string name =
+ intrinsic ? intrinsic->name
+ : procRef.proc().GetSymbol()->GetUltimate().name().ToString();
const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering =
Fortran::lower::getIntrinsicArgumentLowering(name);
mlir::Location loc = getLoc();
- if (Fortran::lower::intrinsicRequiresCustomOptionalHandling(
- procRef, intrinsic, converter)) {
+ if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
+ procRef, *intrinsic, converter)) {
using CcPairT = std::pair<CC, llvm::Optional<mlir::Value>>;
llvm::SmallVector<CcPairT> operands;
auto prepareOptionalArg = [&](const Fortran::lower::SomeExpr &expr) {
@@ -4719,11 +4739,10 @@ class ArrayExprLowering {
operands.emplace_back(genElementalArgument(expr), llvm::None);
};
Fortran::lower::prepareCustomIntrinsicArgument(
- procRef, intrinsic, retTy, prepareOptionalArg, prepareOtherArg,
+ procRef, *intrinsic, retTy, prepareOptionalArg, prepareOtherArg,
converter);
fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
- llvm::StringRef name = intrinsic.name;
return [=](IterSpace iters) -> ExtValue {
auto getArgument = [&](std::size_t i) -> ExtValue {
return operands[i].first(iters);
@@ -4737,11 +4756,9 @@ class ArrayExprLowering {
};
}
/// Otherwise, pre-lower arguments and use intrinsic lowering utility.
- for (const auto &[arg, dummy] :
- llvm::zip(procRef.arguments(),
- intrinsic.characteristics.value().dummyArguments)) {
+ for (const auto &arg : llvm::enumerate(procRef.arguments())) {
const auto *expr =
- Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg);
+ Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
if (!expr) {
// Absent optional.
operands.emplace_back([=](IterSpace) { return mlir::Value{}; });
@@ -4752,8 +4769,7 @@ class ArrayExprLowering {
} else {
// Ad-hoc argument lowering handling.
Fortran::lower::ArgLoweringRule argRules =
- Fortran::lower::lowerIntrinsicArgumentAs(getLoc(), *argLowering,
- dummy.name);
+ Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index());
if (argRules.handleDynamicOptional &&
Fortran::evaluate::MayBePassedAsAbsentOptional(
*expr, converter.getFoldingContext())) {
@@ -4955,6 +4971,8 @@ class ArrayExprLowering {
// The intrinsic procedure is called once per element of the array.
return genElementalIntrinsicProcRef(procRef, retTy, *intrin);
}
+ if (isIntrinsicModuleProcRef(procRef))
+ return genElementalIntrinsicProcRef(procRef, retTy);
if (ScalarExprLowering::isStatementFunctionCall(procRef))
fir::emitFatalError(loc, "statement function cannot be elemental");
@@ -4971,12 +4989,12 @@ class ArrayExprLowering {
// Elide any implicit loop iters.
return [=, &procRef](IterSpace) {
return ScalarExprLowering{loc, converter, symMap, stmtCtx}
- .genIntrinsicRef(procRef, *intrinsic, retTy);
+ .genIntrinsicRef(procRef, retTy, *intrinsic);
};
}
return genarr(
ScalarExprLowering{loc, converter, symMap, stmtCtx}.genIntrinsicRef(
- procRef, *intrinsic, retTy));
+ procRef, retTy, *intrinsic));
}
if (explicitSpaceIsActive() && procRef.Rank() == 0) {
diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index c061d593d7ce2..ba22c24ab93fb 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -43,9 +43,9 @@
#define PGMATH_DECLARE
#include "flang/Evaluate/pgmath.h.inc"
-/// This file implements lowering of Fortran intrinsic procedures.
-/// Intrinsics are lowered to a mix of FIR and MLIR operations as
-/// well as call to runtime functions or LLVM intrinsics.
+/// This file implements lowering of Fortran intrinsic procedures and Fortran
+/// intrinsic module procedures. A call may be inlined with a mix of FIR and
+/// MLIR operations, or as a call to a runtime function or LLVM intrinsic.
/// Lowering of intrinsic procedure calls is based on a map that associates
/// Fortran intrinsic generic names to FIR generator functions.
@@ -493,6 +493,10 @@ struct IntrinsicLibrary {
mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ template <mlir::arith::CmpIPredicate pred>
+ fir::ExtendedValue genIeeeTypeCompare(mlir::Type,
+ llvm::ArrayRef<fir::ExtendedValue>);
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>);
@@ -758,6 +762,11 @@ static constexpr IntrinsicHandler handlers[]{
{"ibits", &I::genIbits},
{"ibset", &I::genIbset},
{"ichar", &I::genIchar},
+ {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
+ {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
+ {"ieee_is_finite", &I::genIeeeIsFinite},
+ {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
+ {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
{"ieor", &I::genIeor},
{"index",
&I::genIndex,
@@ -1410,9 +1419,33 @@ mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
// IntrinsicLibrary
//===----------------------------------------------------------------------===//
-/// Emit a TODO error message for as yet unimplemented intrinsics.
-static void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) {
- TODO(loc, "missing intrinsic lowering: " + llvm::Twine(name));
+static bool isIntrinsicModuleProcedure(llvm::StringRef name) {
+ return name.startswith("c_") || name.startswith("compiler_") ||
+ name.startswith("ieee_");
+}
+
+/// Return the generic name of an intrinsic module procedure specific name.
+/// Remove any "__builtin_" prefix, and any specific suffix of the form
+/// {_[ail]?[0-9]+}*, such as _1 or _a4.
+llvm::StringRef genericName(llvm::StringRef specificName) {
+ const std::string builtin = "__builtin_";
+ llvm::StringRef name = specificName.startswith(builtin)
+ ? specificName.drop_front(builtin.size())
+ : specificName;
+ size_t size = name.size();
+ if (isIntrinsicModuleProcedure(name))
+ while (isdigit(name[size - 1]))
+ while (name[--size] != '_')
+ ;
+ return name.drop_back(name.size() - size);
+}
+
+/// Generate a TODO error message for an as yet unimplemented intrinsic.
+void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) {
+ if (isIntrinsicModuleProcedure(name))
+ TODO(loc, "intrinsic module procedure: " + llvm::Twine(name));
+ else
+ TODO(loc, "intrinsic: " + llvm::Twine(name));
}
template <typename GeneratorType>
@@ -1502,9 +1535,10 @@ invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
}
fir::ExtendedValue
-IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name,
+IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
llvm::Optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args) {
+ llvm::StringRef name = genericName(specificName);
if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
bool outline = handler->outline || outlineAllIntrinsics;
return std::visit(
@@ -1695,10 +1729,10 @@ IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
mlir::func::FuncOp funcOp =
getRuntimeFunction(loc, builder, name, soughtFuncType);
if (!funcOp) {
- std::string buffer("not yet implemented: missing intrinsic lowering: ");
- llvm::raw_string_ostream sstream(buffer);
- sstream << name << "\nrequested type was: " << soughtFuncType << '\n';
- fir::emitFatalError(loc, buffer);
+ std::string nameAndType;
+ llvm::raw_string_ostream sstream(nameAndType);
+ sstream << name << "\nrequested type: " << soughtFuncType;
+ crashOnMissingIntrinsic(loc, nameAndType);
}
mlir::FunctionType actualFuncType = funcOp.getFunctionType();
@@ -2621,6 +2655,67 @@ IntrinsicLibrary::genIchar(mlir::Type resultType,
return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
}
+// IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)
+// IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)
+template <mlir::arith::CmpIPredicate pred>
+fir::ExtendedValue
+IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> 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));
+ return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right);
+}
+
+// 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).
+ 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));
+}
+
// IEOR
mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
@@ -2811,7 +2906,7 @@ IntrinsicLibrary::genLenTrim(mlir::Type resultType,
// LGE, LGT, LLE, LLT
template <mlir::arith::CmpIPredicate pred>
fir::ExtendedValue
-IntrinsicLibrary::genCharacterCompare(mlir::Type type,
+IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,
llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 2);
return fir::runtime::genCharCompare(
@@ -3850,15 +3945,11 @@ Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef intrinsicName) {
/// Return how argument \p argName should be lowered given the rules for the
/// intrinsic function.
Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs(
- mlir::Location loc, const IntrinsicArgumentLoweringRules &rules,
- llvm::StringRef argName) {
- for (const IntrinsicDummyArgument &arg : rules.args) {
- if (arg.name && arg.name == argName)
- return {arg.lowerAs, arg.handleDynamicOptional};
- }
- fir::emitFatalError(
- loc, "internal: unknown intrinsic argument name in lowering '" + argName +
- "'");
+ const IntrinsicArgumentLoweringRules &rules, unsigned position) {
+ assert(position < sizeof(rules.args) / sizeof(decltype(*rules.args)) &&
+ "invalid argument");
+ return {rules.args[position].lowerAs,
+ rules.args[position].handleDynamicOptional};
}
//===----------------------------------------------------------------------===//
diff --git a/flang/module/__fortran_ieee_exceptions.f90 b/flang/module/__fortran_ieee_exceptions.f90
index 0b620f55cee84..7232bbf53cd61 100644
--- a/flang/module/__fortran_ieee_exceptions.f90
+++ b/flang/module/__fortran_ieee_exceptions.f90
@@ -124,13 +124,13 @@ end subroutine ieee_set_status
end interface
#define IEEE_SUPPORT_FLAG_R(XKIND) \
- pure logical function ieee_support_flag_a##XKIND(flag, x); \
+ logical function ieee_support_flag_a##XKIND(flag, x); \
import ieee_flag_type; \
type(ieee_flag_type), intent(in) :: flag; \
real(XKIND), intent(in) :: x(..); \
end function ieee_support_flag_a##XKIND;
interface ieee_support_flag
- pure logical function ieee_support_flag(flag)
+ logical function ieee_support_flag(flag)
import ieee_flag_type
type(ieee_flag_type), intent(in) :: flag
end function ieee_support_flag
diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90
index 365f803aca71e..b2ac217aa86ae 100644
--- a/flang/module/ieee_arithmetic.f90
+++ b/flang/module/ieee_arithmetic.f90
@@ -514,7 +514,7 @@ pure logical function ieee_support_rounding_a##XKIND(round_value, x); \
real(XKIND), intent(in) :: x(..); \
end function ieee_support_rounding_a##XKIND;
interface ieee_support_rounding
- pure logical function ieee_support_rounding(round_value)
+ logical function ieee_support_rounding(round_value)
import ieee_round_type
type(ieee_round_type), intent(in) :: round_value
end function ieee_support_rounding
diff --git a/flang/test/Lower/intrinsic-procedures/ieee_is_finite.f90 b/flang/test/Lower/intrinsic-procedures/ieee_is_finite.f90
new file mode 100644
index 0000000000000..d1a2da0d55bb9
--- /dev/null
+++ b/flang/test/Lower/intrinsic-procedures/ieee_is_finite.f90
@@ -0,0 +1,68 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: @_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
+ 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
+ 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
+ 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
+ print*, ieee_is_finite(y+y)
+end subroutine is_finite_test
+
+ real(4) x
+ real(8) y
+ call is_finite_test(huge(x), huge(y))
+end
diff --git a/flang/test/Lower/intrinsic-procedures/ieee_operator_eq.f90 b/flang/test/Lower/intrinsic-procedures/ieee_operator_eq.f90
new file mode 100644
index 0000000000000..37d0ca02c5fb0
--- /dev/null
+++ b/flang/test/Lower/intrinsic-procedures/ieee_operator_eq.f90
@@ -0,0 +1,46 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: @_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
+ print*, r1 == r2
+end
+
+! CHECK-LABEL: @_QQmain
+ use ieee_arithmetic, only: ieee_round_type, ieee_nearest, ieee_to_zero
+ interface
+ subroutine s(r1,r2)
+ import ieee_round_type
+ 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>
+ 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}>>) -> ()
+ call s(ieee_nearest, ieee_nearest)
+end
More information about the flang-commits
mailing list