forked from OSchip/llvm-project
[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@nvidia.com>
This commit is contained in:
Val Donaldson
Valentin Clement
parent
57b0d940d5
commit
124338dd80
|
|
@ -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();
|
||||
|
|
|
|||
|
|
@ -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 @@ public:
|
|||
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 @@ public:
|
|||
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 @@ public:
|
|||
|
||||
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 @@ public:
|
|||
}
|
||||
// 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 @@ public:
|
|||
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 @@ public:
|
|||
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 @@ public:
|
|||
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 @@ public:
|
|||
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 @@ private:
|
|||
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 @@ private:
|
|||
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 @@ private:
|
|||
};
|
||||
}
|
||||
/// 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 @@ private:
|
|||
} 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 @@ private:
|
|||
// 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 @@ private:
|
|||
// 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) {
|
||||
|
|
|
|||
|
|
@ -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};
|
||||
}
|
||||
|
||||
//===----------------------------------------------------------------------===//
|
||||
|
|
|
|||
|
|
@ -124,13 +124,13 @@ module __Fortran_ieee_exceptions
|
|||
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
|
||||
|
|
|
|||
|
|
@ -514,7 +514,7 @@ module ieee_arithmetic
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
Loading…
Reference in New Issue