72 changes: 35 additions & 37 deletions flang/lib/Lower/ConvertExpr.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,13 +28,13 @@
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/CustomIntrinsicCall.h"
#include "flang/Lower/DumpEvaluateExpr.h"
#include "flang/Lower/IntrinsicCall.h"
#include "flang/Lower/Mangler.h"
#include "flang/Lower/Runtime.h"
#include "flang/Lower/Support/Utils.h"
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/Complex.h"
#include "flang/Optimizer/Builder/Factory.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/Runtime/Assign.h"
#include "flang/Optimizer/Builder/Runtime/Character.h"
#include "flang/Optimizer/Builder/Runtime/Derived.h"
Expand Down Expand Up @@ -897,8 +897,8 @@ class ScalarExprLowering {
converter.getFoldingContext().intrinsics().GetGenericIntrinsicName(
intrinsic->name);
mlir::SymbolRefAttr symbolRefAttr =
Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
builder, loc, genericName, signature);
fir::getUnrestrictedIntrinsicSymbolRefAttr(builder, loc, genericName,
signature);
mlir::Value funcPtr =
builder.create<fir::AddrOfOp>(loc, signature, symbolRefAttr);
return funcPtr;
Expand Down Expand Up @@ -1150,7 +1150,7 @@ class ScalarExprLowering {
mlir::Type ty = converter.genType(TC, KIND);
mlir::Value lhs = genunbox(op.left());
mlir::Value rhs = genunbox(op.right());
return Fortran::lower::genPow(builder, getLoc(), ty, lhs, rhs);
return fir::genPow(builder, getLoc(), ty, lhs, rhs);
}

template <Fortran::common::TypeCategory TC, int KIND>
Expand All @@ -1160,7 +1160,7 @@ class ScalarExprLowering {
mlir::Type ty = converter.genType(TC, KIND);
mlir::Value lhs = genunbox(op.left());
mlir::Value rhs = genunbox(op.right());
return Fortran::lower::genPow(builder, getLoc(), ty, lhs, rhs);
return fir::genPow(builder, getLoc(), ty, lhs, rhs);
}

template <int KIND>
Expand Down Expand Up @@ -1191,11 +1191,11 @@ class ScalarExprLowering {
mlir::Value rhs = genunbox(op.right());
switch (op.ordering) {
case Fortran::evaluate::Ordering::Greater:
return Fortran::lower::genMax(builder, getLoc(),
llvm::ArrayRef<mlir::Value>{lhs, rhs});
return fir::genMax(builder, getLoc(),
llvm::ArrayRef<mlir::Value>{lhs, rhs});
case Fortran::evaluate::Ordering::Less:
return Fortran::lower::genMin(builder, getLoc(),
llvm::ArrayRef<mlir::Value>{lhs, rhs});
return fir::genMin(builder, getLoc(),
llvm::ArrayRef<mlir::Value>{lhs, rhs});
case Fortran::evaluate::Ordering::Equal:
llvm_unreachable("Equal is not a valid ordering in this context");
}
Expand Down Expand Up @@ -1879,14 +1879,14 @@ class ScalarExprLowering {
operands.size(), stmtCtx);
}

const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering =
Fortran::lower::getIntrinsicArgumentLowering(name);
const fir::IntrinsicArgumentLoweringRules *argLowering =
fir::getIntrinsicArgumentLowering(name);
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());
operands.emplace_back(fir::getAbsentIntrinsicArgument());
continue;
}
if (!argLowering) {
Expand All @@ -1895,43 +1895,43 @@ class ScalarExprLowering {
continue;
}
// Ad-hoc argument lowering handling.
Fortran::lower::ArgLoweringRule argRules =
Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index());
fir::ArgLoweringRule argRules =
fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
if (argRules.handleDynamicOptional &&
Fortran::evaluate::MayBePassedAsAbsentOptional(
*expr, converter.getFoldingContext())) {
ExtValue optional = lowerIntrinsicArgumentAsInquired(*expr);
mlir::Value isPresent = genActualIsPresentTest(builder, loc, optional);
switch (argRules.lowerAs) {
case Fortran::lower::LowerIntrinsicArgAs::Value:
case fir::LowerIntrinsicArgAs::Value:
operands.emplace_back(
genOptionalValue(builder, loc, optional, isPresent));
continue;
case Fortran::lower::LowerIntrinsicArgAs::Addr:
case fir::LowerIntrinsicArgAs::Addr:
operands.emplace_back(
genOptionalAddr(builder, loc, optional, isPresent));
continue;
case Fortran::lower::LowerIntrinsicArgAs::Box:
case fir::LowerIntrinsicArgAs::Box:
operands.emplace_back(
genOptionalBox(builder, loc, optional, isPresent));
continue;
case Fortran::lower::LowerIntrinsicArgAs::Inquired:
case fir::LowerIntrinsicArgAs::Inquired:
operands.emplace_back(optional);
continue;
}
llvm_unreachable("bad switch");
}
switch (argRules.lowerAs) {
case Fortran::lower::LowerIntrinsicArgAs::Value:
case fir::LowerIntrinsicArgAs::Value:
operands.emplace_back(genval(*expr));
continue;
case Fortran::lower::LowerIntrinsicArgAs::Addr:
case fir::LowerIntrinsicArgAs::Addr:
operands.emplace_back(gen(*expr));
continue;
case Fortran::lower::LowerIntrinsicArgAs::Box:
case fir::LowerIntrinsicArgAs::Box:
operands.emplace_back(lowerIntrinsicArgumentAsBox(*expr));
continue;
case Fortran::lower::LowerIntrinsicArgAs::Inquired:
case fir::LowerIntrinsicArgAs::Inquired:
operands.emplace_back(lowerIntrinsicArgumentAsInquired(*expr));
continue;
}
Expand Down Expand Up @@ -4477,8 +4477,8 @@ class ArrayExprLowering {
std::string name =
intrinsic ? intrinsic->name
: procRef.proc().GetSymbol()->GetUltimate().name().ToString();
const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering =
Fortran::lower::getIntrinsicArgumentLowering(name);
const fir::IntrinsicArgumentLoweringRules *argLowering =
fir::getIntrinsicArgumentLowering(name);
mlir::Location loc = getLoc();
if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
procRef, *intrinsic, converter)) {
Expand Down Expand Up @@ -4533,39 +4533,39 @@ class ArrayExprLowering {
operands.emplace_back(genElementalArgument(*expr));
} else {
// Ad-hoc argument lowering handling.
Fortran::lower::ArgLoweringRule argRules =
Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index());
fir::ArgLoweringRule argRules =
fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
if (argRules.handleDynamicOptional &&
Fortran::evaluate::MayBePassedAsAbsentOptional(
*expr, converter.getFoldingContext())) {
// Currently, there is not elemental intrinsic that requires lowering
// a potentially absent argument to something else than a value (apart
// from character MAX/MIN that are handled elsewhere.)
if (argRules.lowerAs != Fortran::lower::LowerIntrinsicArgAs::Value)
if (argRules.lowerAs != fir::LowerIntrinsicArgAs::Value)
TODO(loc, "non trivial optional elemental intrinsic array "
"argument");
PushSemantics(ConstituentSemantics::RefTransparent);
operands.emplace_back(genarrForwardOptionalArgumentToCall(*expr));
continue;
}
switch (argRules.lowerAs) {
case Fortran::lower::LowerIntrinsicArgAs::Value: {
case fir::LowerIntrinsicArgAs::Value: {
PushSemantics(ConstituentSemantics::RefTransparent);
operands.emplace_back(genElementalArgument(*expr));
} break;
case Fortran::lower::LowerIntrinsicArgAs::Addr: {
case fir::LowerIntrinsicArgAs::Addr: {
// Note: assume does not have Fortran VALUE attribute semantics.
PushSemantics(ConstituentSemantics::RefOpaque);
operands.emplace_back(genElementalArgument(*expr));
} break;
case Fortran::lower::LowerIntrinsicArgAs::Box: {
case fir::LowerIntrinsicArgAs::Box: {
PushSemantics(ConstituentSemantics::RefOpaque);
auto lambda = genElementalArgument(*expr);
operands.emplace_back([=](IterSpace iters) {
return builder.createBox(loc, lambda(iters));
});
} break;
case Fortran::lower::LowerIntrinsicArgAs::Inquired:
case fir::LowerIntrinsicArgAs::Inquired:
TODO(loc, "intrinsic function with inquired argument");
break;
}
Expand Down Expand Up @@ -5045,7 +5045,7 @@ class ArrayExprLowering {
return [=](IterSpace iters) -> ExtValue {
mlir::Value lhs = fir::getBase(lf(iters));
mlir::Value rhs = fir::getBase(rf(iters));
return Fortran::lower::genPow(builder, loc, ty, lhs, rhs);
return fir::genPow(builder, loc, ty, lhs, rhs);
};
}
template <Fortran::common::TypeCategory TC, int KIND>
Expand All @@ -5059,15 +5059,13 @@ class ArrayExprLowering {
return [=](IterSpace iters) -> ExtValue {
mlir::Value lhs = fir::getBase(lf(iters));
mlir::Value rhs = fir::getBase(rf(iters));
return Fortran::lower::genMax(builder, loc,
llvm::ArrayRef<mlir::Value>{lhs, rhs});
return fir::genMax(builder, loc, llvm::ArrayRef<mlir::Value>{lhs, rhs});
};
case Fortran::evaluate::Ordering::Less:
return [=](IterSpace iters) -> ExtValue {
mlir::Value lhs = fir::getBase(lf(iters));
mlir::Value rhs = fir::getBase(rf(iters));
return Fortran::lower::genMin(builder, loc,
llvm::ArrayRef<mlir::Value>{lhs, rhs});
return fir::genMin(builder, loc, llvm::ArrayRef<mlir::Value>{lhs, rhs});
};
case Fortran::evaluate::Ordering::Equal:
llvm_unreachable("Equal is not a valid ordering in this context");
Expand All @@ -5085,7 +5083,7 @@ class ArrayExprLowering {
return [=](IterSpace iters) {
mlir::Value lhs = fir::getBase(lf(iters));
mlir::Value rhs = fir::getBase(rf(iters));
return Fortran::lower::genPow(builder, loc, ty, lhs, rhs);
return fir::genPow(builder, loc, ty, lhs, rhs);
};
}
template <int KIND>
Expand Down
12 changes: 5 additions & 7 deletions flang/lib/Lower/ConvertExprToHLFIR.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,10 +18,10 @@
#include "flang/Lower/ConvertConstant.h"
#include "flang/Lower/ConvertType.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/IntrinsicCall.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/Complex.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Runtime/Character.h"
#include "flang/Optimizer/Builder/Todo.h"
Expand Down Expand Up @@ -614,8 +614,7 @@ struct BinaryOp<Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>> {
hlfir::Entity lhs, hlfir::Entity rhs) {
mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
/*params=*/std::nullopt);
return hlfir::EntityWithAttributes{
Fortran::lower::genPow(builder, loc, ty, lhs, rhs)};
return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
}
};

Expand All @@ -629,8 +628,7 @@ struct BinaryOp<
hlfir::Entity lhs, hlfir::Entity rhs) {
mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
/*params=*/std::nullopt);
return hlfir::EntityWithAttributes{
Fortran::lower::genPow(builder, loc, ty, lhs, rhs)};
return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
}
};

Expand All @@ -644,8 +642,8 @@ struct BinaryOp<
hlfir::Entity rhs) {
llvm::SmallVector<mlir::Value, 2> args{lhs, rhs};
fir::ExtendedValue res = op.ordering == Fortran::evaluate::Ordering::Greater
? Fortran::lower::genMax(builder, loc, args)
: Fortran::lower::genMin(builder, loc, args);
? fir::genMax(builder, loc, args)
: fir::genMin(builder, loc, args);
return hlfir::EntityWithAttributes{fir::getBase(res)};
}
};
Expand Down
2 changes: 1 addition & 1 deletion flang/lib/Lower/ConvertVariable.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,6 @@
#include "flang/Lower/ConvertConstant.h"
#include "flang/Lower/ConvertExpr.h"
#include "flang/Lower/ConvertExprToHLFIR.h"
#include "flang/Lower/IntrinsicCall.h"
#include "flang/Lower/Mangler.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Lower/StatementContext.h"
Expand All @@ -27,6 +26,7 @@
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/HLFIRTools.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/Runtime/Derived.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIRAttr.h"
Expand Down
41 changes: 31 additions & 10 deletions flang/lib/Lower/CustomIntrinsicCall.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,8 @@
#include "flang/Evaluate/expression.h"
#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/tools.h"
#include "flang/Lower/IntrinsicCall.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/Todo.h"
#include <optional>

Expand Down Expand Up @@ -63,6 +64,28 @@ bool Fortran::lower::intrinsicRequiresCustomOptionalHandling(
isIshftcWithDynamicallyOptionalArg(name, procRef, fldCtx);
}

/// Generate the FIR+MLIR operations for the generic intrinsic \p name
/// with arguments \p args and the expected result type \p resultType.
/// Returned fir::ExtendedValue is the returned Fortran intrinsic value.
fir::ExtendedValue
Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::StringRef name,
std::optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args,
Fortran::lower::StatementContext &stmtCtx) {
auto [result, mustBeFreed] =
fir::genIntrinsicCall(builder, loc, name, resultType, args);
if (mustBeFreed) {
mlir::Value addr = fir::getBase(result);
if (auto *box = result.getBoxOf<fir::BoxValue>())
addr =
builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), box->getAddr());
fir::FirOpBuilder *bldr = &builder;
stmtCtx.attachCleanup([=]() { bldr->create<fir::FreeMemOp>(loc, addr); });
}
return result;
}

static void prepareMinOrMaxArguments(
const Fortran::evaluate::ProcedureRef &procRef,
const Fortran::evaluate::SpecificIntrinsic &intrinsic,
Expand Down Expand Up @@ -108,8 +131,8 @@ lowerMinOrMax(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::SmallVector<fir::ExtendedValue> args;
args.push_back(getOperand(0));
args.push_back(getOperand(1));
mlir::Value extremum = fir::getBase(Fortran::lower::genIntrinsicCall(
builder, loc, name, resultType, args, stmtCtx));
mlir::Value extremum = fir::getBase(
genIntrinsicCall(builder, loc, name, resultType, args, stmtCtx));

for (std::size_t opIndex = 2; opIndex < numOperands; ++opIndex) {
if (std::optional<mlir::Value> isPresentRuntimeCheck =
Expand All @@ -123,9 +146,8 @@ lowerMinOrMax(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::SmallVector<fir::ExtendedValue> args;
args.emplace_back(extremum);
args.emplace_back(getOperand(opIndex));
fir::ExtendedValue newExtremum =
Fortran::lower::genIntrinsicCall(builder, loc, name,
resultType, args, stmtCtx);
fir::ExtendedValue newExtremum = genIntrinsicCall(
builder, loc, name, resultType, args, stmtCtx);
builder.create<fir::ResultOp>(loc, fir::getBase(newExtremum));
})
.genElse([&]() { builder.create<fir::ResultOp>(loc, extremum); })
Expand All @@ -135,8 +157,8 @@ lowerMinOrMax(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::SmallVector<fir::ExtendedValue> args;
args.emplace_back(extremum);
args.emplace_back(getOperand(opIndex));
extremum = fir::getBase(Fortran::lower::genIntrinsicCall(
builder, loc, name, resultType, args, stmtCtx));
extremum = fir::getBase(
genIntrinsicCall(builder, loc, name, resultType, args, stmtCtx));
}
}
return extremum;
Expand Down Expand Up @@ -198,8 +220,7 @@ lowerIshftc(fir::FirOpBuilder &builder, mlir::Location loc,
builder.create<fir::ResultOp>(loc, bitSize);
})
.getResults()[0]);
return Fortran::lower::genIntrinsicCall(builder, loc, name, resultType, args,
stmtCtx);
return genIntrinsicCall(builder, loc, name, resultType, args, stmtCtx);
}

void Fortran::lower::prepareCustomIntrinsicArgument(
Expand Down
46 changes: 0 additions & 46 deletions flang/lib/Lower/Mangler.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -231,52 +231,6 @@ std::string Fortran::lower::mangle::mangleArrayLiteral(
return name += hashString.c_str();
}

//===----------------------------------------------------------------------===//
// Intrinsic Procedure Mangling
//===----------------------------------------------------------------------===//

/// Helper to encode type into string for intrinsic procedure names.
/// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not
/// suitable for function names.
static std::string typeToString(mlir::Type t) {
if (auto refT{t.dyn_cast<fir::ReferenceType>()})
return "ref_" + typeToString(refT.getEleTy());
if (auto i{t.dyn_cast<mlir::IntegerType>()}) {
return "i" + std::to_string(i.getWidth());
}
if (auto cplx{t.dyn_cast<fir::ComplexType>()}) {
return "z" + std::to_string(cplx.getFKind());
}
if (auto real{t.dyn_cast<fir::RealType>()}) {
return "r" + std::to_string(real.getFKind());
}
if (auto f{t.dyn_cast<mlir::FloatType>()}) {
return "f" + std::to_string(f.getWidth());
}
if (auto logical{t.dyn_cast<fir::LogicalType>()}) {
return "l" + std::to_string(logical.getFKind());
}
if (auto character{t.dyn_cast<fir::CharacterType>()}) {
return "c" + std::to_string(character.getFKind());
}
if (auto boxCharacter{t.dyn_cast<fir::BoxCharType>()}) {
return "bc" + std::to_string(boxCharacter.getEleTy().getFKind());
}
llvm_unreachable("no mangling for type");
}

std::string fir::mangleIntrinsicProcedure(llvm::StringRef intrinsic,
mlir::FunctionType funTy) {
std::string name = "fir.";
name.append(intrinsic.str()).append(".");
assert(funTy.getNumResults() == 1 && "only function mangling supported");
name.append(typeToString(funTy.getResult(0)));
unsigned e = funTy.getNumInputs();
for (decltype(e) i = 0; i < e; ++i)
name.append(".").append(typeToString(funTy.getInput(i)));
return name;
}

std::string Fortran::lower::mangle::globalNamelistDescriptorName(
const Fortran::semantics::Symbol &sym) {
std::string name = mangleName(sym);
Expand Down
212 changes: 0 additions & 212 deletions flang/lib/Lower/Runtime.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -177,18 +177,6 @@ void Fortran::lower::genPauseStatement(
builder.create<fir::CallOp>(loc, callee, std::nullopt);
}

mlir::Value Fortran::lower::genAssociated(fir::FirOpBuilder &builder,
mlir::Location loc,
mlir::Value pointer,
mlir::Value target) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(PointerIsAssociatedWith)>(loc,
builder);
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, func.getFunctionType(), pointer, target);
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
}

void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder,
mlir::Location loc,
mlir::Value pointer,
Expand Down Expand Up @@ -217,203 +205,3 @@ void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder,
sourceLine);
builder.create<fir::CallOp>(loc, func, args).getResult(0);
}

mlir::Value Fortran::lower::genCpuTime(fir::FirOpBuilder &builder,
mlir::Location loc) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(CpuTime)>(loc, builder);
return builder.create<fir::CallOp>(loc, func, std::nullopt).getResult(0);
}

void Fortran::lower::genDateAndTime(fir::FirOpBuilder &builder,
mlir::Location loc,
std::optional<fir::CharBoxValue> date,
std::optional<fir::CharBoxValue> time,
std::optional<fir::CharBoxValue> zone,
mlir::Value values) {
mlir::func::FuncOp callee =
fir::runtime::getRuntimeFunc<mkRTKey(DateAndTime)>(loc, builder);
mlir::FunctionType funcTy = callee.getFunctionType();
mlir::Type idxTy = builder.getIndexType();
mlir::Value zero;
auto splitArg = [&](std::optional<fir::CharBoxValue> arg, mlir::Value &buffer,
mlir::Value &len) {
if (arg) {
buffer = arg->getBuffer();
len = arg->getLen();
} else {
if (!zero)
zero = builder.createIntegerConstant(loc, idxTy, 0);
buffer = zero;
len = zero;
}
};
mlir::Value dateBuffer;
mlir::Value dateLen;
splitArg(date, dateBuffer, dateLen);
mlir::Value timeBuffer;
mlir::Value timeLen;
splitArg(time, timeBuffer, timeLen);
mlir::Value zoneBuffer;
mlir::Value zoneLen;
splitArg(zone, zoneBuffer, zoneLen);

mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, funcTy.getInput(7));

llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, funcTy, dateBuffer, dateLen, timeBuffer, timeLen,
zoneBuffer, zoneLen, sourceFile, sourceLine, values);
builder.create<fir::CallOp>(loc, callee, args);
}

void Fortran::lower::genRandomInit(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value repeatable,
mlir::Value imageDistinct) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(RandomInit)>(loc, builder);
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, func.getFunctionType(), repeatable, imageDistinct);
builder.create<fir::CallOp>(loc, func, args);
}

void Fortran::lower::genRandomNumber(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value harvest) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
mlir::FunctionType funcTy = func.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, funcTy, harvest, sourceFile, sourceLine);
builder.create<fir::CallOp>(loc, func, args);
}

void Fortran::lower::genRandomSeed(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value size,
mlir::Value put, mlir::Value get) {
bool sizeIsPresent =
!mlir::isa_and_nonnull<fir::AbsentOp>(size.getDefiningOp());
bool putIsPresent =
!mlir::isa_and_nonnull<fir::AbsentOp>(put.getDefiningOp());
bool getIsPresent =
!mlir::isa_and_nonnull<fir::AbsentOp>(get.getDefiningOp());
mlir::func::FuncOp func;
int staticArgCount = sizeIsPresent + putIsPresent + getIsPresent;
if (staticArgCount == 0) {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedDefaultPut)>(loc,
builder);
builder.create<fir::CallOp>(loc, func);
return;
}
mlir::FunctionType funcTy;
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine;
mlir::Value argBox;
llvm::SmallVector<mlir::Value> args;
if (staticArgCount > 1) {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeed)>(loc, builder);
funcTy = func.getFunctionType();
sourceLine =
fir::factory::locationToLineNo(builder, loc, funcTy.getInput(4));
args = fir::runtime::createArguments(builder, loc, funcTy, size, put, get,
sourceFile, sourceLine);
builder.create<fir::CallOp>(loc, func, args);
return;
}
if (sizeIsPresent) {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedSize)>(loc, builder);
argBox = size;
} else if (putIsPresent) {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedPut)>(loc, builder);
argBox = put;
} else {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedGet)>(loc, builder);
argBox = get;
}
funcTy = func.getFunctionType();
sourceLine = fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
args = fir::runtime::createArguments(builder, loc, funcTy, argBox, sourceFile,
sourceLine);
builder.create<fir::CallOp>(loc, func, args);
}

/// generate runtime call to transfer intrinsic with no size argument
void Fortran::lower::genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value resultBox, mlir::Value sourceBox,
mlir::Value moldBox) {

mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(Transfer)>(loc, builder);
mlir::FunctionType fTy = func.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, fTy, resultBox, sourceBox, moldBox, sourceFile, sourceLine);
builder.create<fir::CallOp>(loc, func, args);
}

/// generate runtime call to transfer intrinsic with size argument
void Fortran::lower::genTransferSize(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value resultBox,
mlir::Value sourceBox, mlir::Value moldBox,
mlir::Value size) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(TransferSize)>(loc, builder);
mlir::FunctionType fTy = func.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
llvm::SmallVector<mlir::Value> args =
fir::runtime::createArguments(builder, loc, fTy, resultBox, sourceBox,
moldBox, sourceFile, sourceLine, size);
builder.create<fir::CallOp>(loc, func, args);
}

/// generate system_clock runtime call/s
/// all intrinsic arguments are optional and may appear here as mlir::Value{}
void Fortran::lower::genSystemClock(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value count,
mlir::Value rate, mlir::Value max) {
auto makeCall = [&](mlir::func::FuncOp func, mlir::Value arg) {
mlir::Type type = arg.getType();
fir::IfOp ifOp{};
const bool isOptionalArg =
fir::valueHasFirAttribute(arg, fir::getOptionalAttrName());
if (type.dyn_cast<fir::PointerType>() || type.dyn_cast<fir::HeapType>()) {
// Check for a disassociated pointer or an unallocated allocatable.
assert(!isOptionalArg && "invalid optional argument");
ifOp = builder.create<fir::IfOp>(loc, builder.genIsNotNullAddr(loc, arg),
/*withElseRegion=*/false);
} else if (isOptionalArg) {
ifOp = builder.create<fir::IfOp>(
loc, builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), arg),
/*withElseRegion=*/false);
}
if (ifOp)
builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
mlir::Type kindTy = func.getFunctionType().getInput(0);
int integerKind = 8;
if (auto intType = fir::unwrapRefType(type).dyn_cast<mlir::IntegerType>())
integerKind = intType.getWidth() / 8;
mlir::Value kind = builder.createIntegerConstant(loc, kindTy, integerKind);
mlir::Value res =
builder.create<fir::CallOp>(loc, func, mlir::ValueRange{kind})
.getResult(0);
mlir::Value castRes =
builder.createConvert(loc, fir::dyn_cast_ptrEleTy(type), res);
builder.create<fir::StoreOp>(loc, castRes, arg);
if (ifOp)
builder.setInsertionPointAfter(ifOp);
};
using fir::runtime::getRuntimeFunc;
if (count)
makeCall(getRuntimeFunc<mkRTKey(SystemClockCount)>(loc, builder), count);
if (rate)
makeCall(getRuntimeFunc<mkRTKey(SystemClockCountRate)>(loc, builder), rate);
if (max)
makeCall(getRuntimeFunc<mkRTKey(SystemClockCountMax)>(loc, builder), max);
}
2 changes: 2 additions & 0 deletions flang/lib/Optimizer/Builder/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ add_flang_library(FIRBuilder
DoLoopHelper.cpp
FIRBuilder.cpp
HLFIRTools.cpp
IntrinsicCall.cpp
LowLevelIntrinsics.cpp
MutableBox.cpp
Runtime/Allocatable.cpp
Expand All @@ -16,6 +17,7 @@ add_flang_library(FIRBuilder
Runtime/Derived.cpp
Runtime/EnvironmentDefaults.cpp
Runtime/Inquiry.cpp
Runtime/Intrinsics.cpp
Runtime/Numeric.cpp
Runtime/Ragged.cpp
Runtime/Reduction.cpp
Expand Down
162 changes: 96 additions & 66 deletions flang/lib/Lower/IntrinsicCall.cpp → ...g/lib/Optimizer/Builder/IntrinsicCall.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,13 +13,8 @@
//
//===----------------------------------------------------------------------===//

#include "flang/Lower/IntrinsicCall.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Common/static-multimap-view.h"
#include "flang/Lower/Mangler.h"
#include "flang/Lower/Runtime.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/BoxValue.h"
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/Complex.h"
Expand All @@ -30,6 +25,7 @@
#include "flang/Optimizer/Builder/Runtime/Command.h"
#include "flang/Optimizer/Builder/Runtime/Derived.h"
#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"
#include "flang/Optimizer/Builder/Runtime/Numeric.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
#include "flang/Optimizer/Builder/Runtime/Reduction.h"
Expand All @@ -38,6 +34,7 @@
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Optimizer/Support/FatalError.h"
#include "flang/Optimizer/Support/Utils.h"
#include "flang/Runtime/entry-names.h"
#include "mlir/Dialect/Complex/IR/Complex.h"
#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
Expand Down Expand Up @@ -104,7 +101,7 @@ enum class ExtremumBehavior {
// possible to implement it without some target dependent runtime.
};

fir::ExtendedValue Fortran::lower::getAbsentIntrinsicArgument() {
fir::ExtendedValue fir::getAbsentIntrinsicArgument() {
return fir::UnboxedValue{};
}

Expand Down Expand Up @@ -414,13 +411,12 @@ struct IntrinsicLibrary {

struct IntrinsicDummyArgument {
const char *name = nullptr;
Fortran::lower::LowerIntrinsicArgAs lowerAs =
Fortran::lower::LowerIntrinsicArgAs::Value;
fir::LowerIntrinsicArgAs lowerAs = fir::LowerIntrinsicArgAs::Value;
bool handleDynamicOptional = false;
};

/// This is shared by intrinsics and intrinsic module procedures.
struct Fortran::lower::IntrinsicArgumentLoweringRules {
struct fir::IntrinsicArgumentLoweringRules {
/// There is no more than 7 non repeated arguments in Fortran intrinsics.
IntrinsicDummyArgument args[7];
constexpr bool hasDefaultRules() const { return args[0].name == nullptr; }
Expand All @@ -432,17 +428,17 @@ struct IntrinsicHandler {
const char *name;
IntrinsicLibrary::Generator generator;
// The following may be omitted in the table below.
Fortran::lower::IntrinsicArgumentLoweringRules argLoweringRules = {};
fir::IntrinsicArgumentLoweringRules argLoweringRules = {};
bool isElemental = true;
/// Code heavy intrinsic can be outlined to make FIR
/// more readable.
bool outline = false;
};

constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value;
constexpr auto asAddr = Fortran::lower::LowerIntrinsicArgAs::Addr;
constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box;
constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired;
constexpr auto asValue = fir::LowerIntrinsicArgAs::Value;
constexpr auto asAddr = fir::LowerIntrinsicArgAs::Addr;
constexpr auto asBox = fir::LowerIntrinsicArgAs::Box;
constexpr auto asInquired = fir::LowerIntrinsicArgAs::Inquired;
using I = IntrinsicLibrary;

/// Flag to indicate that an intrinsic argument has to be handled as
Expand Down Expand Up @@ -1816,12 +1812,66 @@ IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
return {};
}

//===----------------------------------------------------------------------===//
// Intrinsic Procedure Mangling
//===----------------------------------------------------------------------===//

/// Helper to encode type into string for intrinsic procedure names.
/// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not
/// suitable for function names.
static std::string typeToString(mlir::Type t) {
if (auto refT{t.dyn_cast<fir::ReferenceType>()})
return "ref_" + typeToString(refT.getEleTy());
if (auto i{t.dyn_cast<mlir::IntegerType>()}) {
return "i" + std::to_string(i.getWidth());
}
if (auto cplx{t.dyn_cast<fir::ComplexType>()}) {
return "z" + std::to_string(cplx.getFKind());
}
if (auto real{t.dyn_cast<fir::RealType>()}) {
return "r" + std::to_string(real.getFKind());
}
if (auto f{t.dyn_cast<mlir::FloatType>()}) {
return "f" + std::to_string(f.getWidth());
}
if (auto logical{t.dyn_cast<fir::LogicalType>()}) {
return "l" + std::to_string(logical.getFKind());
}
if (auto character{t.dyn_cast<fir::CharacterType>()}) {
return "c" + std::to_string(character.getFKind());
}
if (auto boxCharacter{t.dyn_cast<fir::BoxCharType>()}) {
return "bc" + std::to_string(boxCharacter.getEleTy().getFKind());
}
llvm_unreachable("no mangling for type");
}

/// Returns a name suitable to define mlir functions for Fortran intrinsic
/// Procedure. These names are guaranteed to not conflict with user defined
/// procedures. This is needed to implement Fortran generic intrinsics as
/// several mlir functions specialized for the argument types.
/// The result is guaranteed to be distinct for different mlir::FunctionType
/// arguments. The mangling pattern is:
/// fir.<generic name>.<result type>.<arg type>...
/// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z4
static std::string mangleIntrinsicProcedure(llvm::StringRef intrinsic,
mlir::FunctionType funTy) {
std::string name = "fir.";
name.append(intrinsic.str()).append(".");
assert(funTy.getNumResults() == 1 && "only function mangling supported");
name.append(typeToString(funTy.getResult(0)));
unsigned e = funTy.getNumInputs();
for (decltype(e) i = 0; i < e; ++i)
name.append(".").append(typeToString(funTy.getInput(i)));
return name;
}

template <typename GeneratorType>
mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
llvm::StringRef name,
mlir::FunctionType funcType,
bool loadRefArguments) {
std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType);
std::string wrapperName = mangleIntrinsicProcedure(name, funcType);
mlir::func::FuncOp function = builder.getNamedFunction(wrapperName);
if (!function) {
// First time this wrapper is needed, build it.
Expand Down Expand Up @@ -2274,7 +2324,7 @@ IntrinsicLibrary::genAssociated(mlir::Type resultType,
mlir::Value pointerBoxRef =
fir::factory::getMutableIRBox(builder, loc, *pointer);
auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox);
return fir::runtime::genAssociated(builder, loc, pointerBox, targetBox);
}

// BESSEL_JN
Expand Down Expand Up @@ -2765,7 +2815,7 @@ void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 1);
const mlir::Value *arg = args[0].getUnboxed();
assert(arg && "nonscalar cpu_time argument");
mlir::Value res1 = Fortran::lower::genCpuTime(builder, loc);
mlir::Value res1 = fir::runtime::genCpuTime(builder, loc);
mlir::Value res2 =
builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);
builder.create<fir::StoreOp>(loc, res2, *arg);
Expand Down Expand Up @@ -2825,8 +2875,8 @@ void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
values = builder.create<fir::AbsentOp>(
loc, fir::BoxType::get(builder.getNoneType()));

Fortran::lower::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
charArgs[2], values);
fir::runtime::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
charArgs[2], values);
}

// DIM
Expand Down Expand Up @@ -4191,15 +4241,15 @@ IntrinsicLibrary::genProduct(mlir::Type resultType,
// RANDOM_INIT
void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 2);
Fortran::lower::genRandomInit(builder, loc, fir::getBase(args[0]),
fir::getBase(args[1]));
fir::runtime::genRandomInit(builder, loc, fir::getBase(args[0]),
fir::getBase(args[1]));
}

// RANDOM_NUMBER
void IntrinsicLibrary::genRandomNumber(
llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 1);
Fortran::lower::genRandomNumber(builder, loc, fir::getBase(args[0]));
fir::runtime::genRandomNumber(builder, loc, fir::getBase(args[0]));
}

// RANDOM_SEED
Expand All @@ -4214,7 +4264,7 @@ void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
mlir::Value size = getDesc(0);
mlir::Value put = getDesc(1);
mlir::Value get = getDesc(2);
Fortran::lower::genRandomSeed(builder, loc, size, put, get);
fir::runtime::genRandomSeed(builder, loc, size, put, get);
}

// REDUCE
Expand Down Expand Up @@ -4852,8 +4902,8 @@ IntrinsicLibrary::genSum(mlir::Type resultType,
// SYSTEM_CLOCK
void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 3);
Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]),
fir::getBase(args[1]), fir::getBase(args[2]));
fir::runtime::genSystemClock(builder, loc, fir::getBase(args[0]),
fir::getBase(args[1]), fir::getBase(args[2]));
}

// TRANSFER
Expand Down Expand Up @@ -4885,18 +4935,18 @@ IntrinsicLibrary::genTransfer(mlir::Type resultType,
mlir::Value resultIrBox =
fir::factory::getMutableIRBox(builder, loc, resultMutableBox);

Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold);
} else {
// The result is a rank one array in this case.
mlir::Value resultIrBox =
fir::factory::getMutableIRBox(builder, loc, resultMutableBox);

if (absentSize) {
Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold);
} else {
mlir::Value sizeArg = fir::getBase(args[2]);
Fortran::lower::genTransferSize(builder, loc, resultIrBox, source, mold,
sizeArg);
fir::runtime::genTransferSize(builder, loc, resultIrBox, source, mold,
sizeArg);
}
}
return readAndAddCleanUp(resultMutableBox, resultType, "TRANSFER");
Expand Down Expand Up @@ -5284,8 +5334,8 @@ mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
// procedure.
//===----------------------------------------------------------------------===//

const Fortran::lower::IntrinsicArgumentLoweringRules *
Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef specificName) {
const fir::IntrinsicArgumentLoweringRules *
fir::getIntrinsicArgumentLowering(llvm::StringRef specificName) {
llvm::StringRef name = genericName(specificName);
if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
if (!handler->argLoweringRules.hasDefaultRules())
Expand All @@ -5295,8 +5345,9 @@ Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef specificName) {

/// Return how argument \p argName should be lowered given the rules for the
/// intrinsic function.
Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs(
const IntrinsicArgumentLoweringRules &rules, unsigned position) {
fir::ArgLoweringRule
fir::lowerIntrinsicArgumentAs(const IntrinsicArgumentLoweringRules &rules,
unsigned position) {
assert(position < sizeof(rules.args) / (sizeof(decltype(*rules.args))) &&
"invalid argument");
return {rules.args[position].lowerAs,
Expand All @@ -5307,54 +5358,33 @@ Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs(
// Public intrinsic call helpers
//===----------------------------------------------------------------------===//

fir::ExtendedValue
Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::StringRef name,
std::optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args,
Fortran::lower::StatementContext &stmtCtx) {
auto [result, mustBeFreed] =
IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType, args);
if (mustBeFreed) {
mlir::Value addr = fir::getBase(result);
if (auto *box = result.getBoxOf<fir::BoxValue>())
addr =
builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), box->getAddr());
fir::FirOpBuilder *bldr = &builder;
stmtCtx.attachCleanup([=]() { bldr->create<fir::FreeMemOp>(loc, addr); });
}
return result;
}
std::pair<fir::ExtendedValue, bool>
Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::StringRef name,
std::optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args) {
fir::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::StringRef name,
std::optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args) {
return IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType,
args);
}

mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder,
mlir::Location loc,
llvm::ArrayRef<mlir::Value> args) {
mlir::Value fir::genMax(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() > 0 && "max requires at least one argument");
return IntrinsicLibrary{builder, loc}
.genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
args);
}

mlir::Value Fortran::lower::genMin(fir::FirOpBuilder &builder,
mlir::Location loc,
llvm::ArrayRef<mlir::Value> args) {
mlir::Value fir::genMin(fir::FirOpBuilder &builder, mlir::Location loc,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() > 0 && "min requires at least one argument");
return IntrinsicLibrary{builder, loc}
.genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),
args);
}

mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Type type,
mlir::Value x, mlir::Value y) {
mlir::Value fir::genPow(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Type type, mlir::Value x, mlir::Value y) {
// TODO: since there is no libm version of pow with integer exponent,
// we have to provide an alternative implementation for
// "precise/strict" FP mode.
Expand All @@ -5365,7 +5395,7 @@ mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder,
return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
}

mlir::SymbolRefAttr Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
mlir::SymbolRefAttr fir::getUnrestrictedIntrinsicSymbolRefAttr(
fir::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name,
mlir::FunctionType signature) {
return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
Expand Down
238 changes: 238 additions & 0 deletions flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,238 @@
//===-- Intrinsics.cpp ----------------------------------------------------===//
//
// 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
//
//===----------------------------------------------------------------------===//

#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"
#include "flang/Optimizer/Builder/BoxValue.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Runtime/misc-intrinsic.h"
#include "flang/Runtime/pointer.h"
#include "flang/Runtime/random.h"
#include "flang/Runtime/stop.h"
#include "flang/Runtime/time-intrinsic.h"
#include "flang/Semantics/tools.h"
#include "llvm/Support/Debug.h"
#include <optional>

#define DEBUG_TYPE "flang-lower-runtime"

using namespace Fortran::runtime;

mlir::Value fir::runtime::genAssociated(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value pointer,
mlir::Value target) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(PointerIsAssociatedWith)>(loc,
builder);
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, func.getFunctionType(), pointer, target);
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
}

mlir::Value fir::runtime::genCpuTime(fir::FirOpBuilder &builder,
mlir::Location loc) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(CpuTime)>(loc, builder);
return builder.create<fir::CallOp>(loc, func, std::nullopt).getResult(0);
}

void fir::runtime::genDateAndTime(fir::FirOpBuilder &builder,
mlir::Location loc,
std::optional<fir::CharBoxValue> date,
std::optional<fir::CharBoxValue> time,
std::optional<fir::CharBoxValue> zone,
mlir::Value values) {
mlir::func::FuncOp callee =
fir::runtime::getRuntimeFunc<mkRTKey(DateAndTime)>(loc, builder);
mlir::FunctionType funcTy = callee.getFunctionType();
mlir::Type idxTy = builder.getIndexType();
mlir::Value zero;
auto splitArg = [&](std::optional<fir::CharBoxValue> arg, mlir::Value &buffer,
mlir::Value &len) {
if (arg) {
buffer = arg->getBuffer();
len = arg->getLen();
} else {
if (!zero)
zero = builder.createIntegerConstant(loc, idxTy, 0);
buffer = zero;
len = zero;
}
};
mlir::Value dateBuffer;
mlir::Value dateLen;
splitArg(date, dateBuffer, dateLen);
mlir::Value timeBuffer;
mlir::Value timeLen;
splitArg(time, timeBuffer, timeLen);
mlir::Value zoneBuffer;
mlir::Value zoneLen;
splitArg(zone, zoneBuffer, zoneLen);

mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, funcTy.getInput(7));

llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, funcTy, dateBuffer, dateLen, timeBuffer, timeLen,
zoneBuffer, zoneLen, sourceFile, sourceLine, values);
builder.create<fir::CallOp>(loc, callee, args);
}

void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value repeatable,
mlir::Value imageDistinct) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(RandomInit)>(loc, builder);
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, func.getFunctionType(), repeatable, imageDistinct);
builder.create<fir::CallOp>(loc, func, args);
}

void fir::runtime::genRandomNumber(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value harvest) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
mlir::FunctionType funcTy = func.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, funcTy, harvest, sourceFile, sourceLine);
builder.create<fir::CallOp>(loc, func, args);
}

void fir::runtime::genRandomSeed(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value size, mlir::Value put,
mlir::Value get) {
bool sizeIsPresent =
!mlir::isa_and_nonnull<fir::AbsentOp>(size.getDefiningOp());
bool putIsPresent =
!mlir::isa_and_nonnull<fir::AbsentOp>(put.getDefiningOp());
bool getIsPresent =
!mlir::isa_and_nonnull<fir::AbsentOp>(get.getDefiningOp());
mlir::func::FuncOp func;
int staticArgCount = sizeIsPresent + putIsPresent + getIsPresent;
if (staticArgCount == 0) {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedDefaultPut)>(loc,
builder);
builder.create<fir::CallOp>(loc, func);
return;
}
mlir::FunctionType funcTy;
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine;
mlir::Value argBox;
llvm::SmallVector<mlir::Value> args;
if (staticArgCount > 1) {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeed)>(loc, builder);
funcTy = func.getFunctionType();
sourceLine =
fir::factory::locationToLineNo(builder, loc, funcTy.getInput(4));
args = fir::runtime::createArguments(builder, loc, funcTy, size, put, get,
sourceFile, sourceLine);
builder.create<fir::CallOp>(loc, func, args);
return;
}
if (sizeIsPresent) {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedSize)>(loc, builder);
argBox = size;
} else if (putIsPresent) {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedPut)>(loc, builder);
argBox = put;
} else {
func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedGet)>(loc, builder);
argBox = get;
}
funcTy = func.getFunctionType();
sourceLine = fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
args = fir::runtime::createArguments(builder, loc, funcTy, argBox, sourceFile,
sourceLine);
builder.create<fir::CallOp>(loc, func, args);
}

/// generate runtime call to transfer intrinsic with no size argument
void fir::runtime::genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value resultBox, mlir::Value sourceBox,
mlir::Value moldBox) {

mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(Transfer)>(loc, builder);
mlir::FunctionType fTy = func.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
builder, loc, fTy, resultBox, sourceBox, moldBox, sourceFile, sourceLine);
builder.create<fir::CallOp>(loc, func, args);
}

/// generate runtime call to transfer intrinsic with size argument
void fir::runtime::genTransferSize(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value resultBox,
mlir::Value sourceBox, mlir::Value moldBox,
mlir::Value size) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(TransferSize)>(loc, builder);
mlir::FunctionType fTy = func.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
llvm::SmallVector<mlir::Value> args =
fir::runtime::createArguments(builder, loc, fTy, resultBox, sourceBox,
moldBox, sourceFile, sourceLine, size);
builder.create<fir::CallOp>(loc, func, args);
}

/// generate system_clock runtime call/s
/// all intrinsic arguments are optional and may appear here as mlir::Value{}
void fir::runtime::genSystemClock(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value count,
mlir::Value rate, mlir::Value max) {
auto makeCall = [&](mlir::func::FuncOp func, mlir::Value arg) {
mlir::Type type = arg.getType();
fir::IfOp ifOp{};
const bool isOptionalArg =
fir::valueHasFirAttribute(arg, fir::getOptionalAttrName());
if (type.dyn_cast<fir::PointerType>() || type.dyn_cast<fir::HeapType>()) {
// Check for a disassociated pointer or an unallocated allocatable.
assert(!isOptionalArg && "invalid optional argument");
ifOp = builder.create<fir::IfOp>(loc, builder.genIsNotNullAddr(loc, arg),
/*withElseRegion=*/false);
} else if (isOptionalArg) {
ifOp = builder.create<fir::IfOp>(
loc, builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), arg),
/*withElseRegion=*/false);
}
if (ifOp)
builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
mlir::Type kindTy = func.getFunctionType().getInput(0);
int integerKind = 8;
if (auto intType = fir::unwrapRefType(type).dyn_cast<mlir::IntegerType>())
integerKind = intType.getWidth() / 8;
mlir::Value kind = builder.createIntegerConstant(loc, kindTy, integerKind);
mlir::Value res =
builder.create<fir::CallOp>(loc, func, mlir::ValueRange{kind})
.getResult(0);
mlir::Value castRes =
builder.createConvert(loc, fir::dyn_cast_ptrEleTy(type), res);
builder.create<fir::StoreOp>(loc, castRes, arg);
if (ifOp)
builder.setInsertionPointAfter(ifOp);
};
using fir::runtime::getRuntimeFunc;
if (count)
makeCall(getRuntimeFunc<mkRTKey(SystemClockCount)>(loc, builder), count);
if (rate)
makeCall(getRuntimeFunc<mkRTKey(SystemClockCountRate)>(loc, builder), rate);
if (max)
makeCall(getRuntimeFunc<mkRTKey(SystemClockCountMax)>(loc, builder), max);
}