345 lines · cpp
1//===-- CustomIntrinsicCall.cpp -------------------------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8//9// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/10//11//===----------------------------------------------------------------------===//12 13#include "flang/Lower/CustomIntrinsicCall.h"14#include "flang/Evaluate/expression.h"15#include "flang/Evaluate/fold.h"16#include "flang/Evaluate/tools.h"17#include "flang/Lower/StatementContext.h"18#include "flang/Optimizer/Builder/IntrinsicCall.h"19#include "flang/Optimizer/Builder/Todo.h"20#include "flang/Semantics/tools.h"21#include <optional>22 23/// Is this a call to MIN or MAX intrinsic with arguments that may be absent at24/// runtime? This is a special case because MIN and MAX can have any number of25/// arguments.26static bool isMinOrMaxWithDynamicallyOptionalArg(27 llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef) {28 if (name != "min" && name != "max")29 return false;30 const auto &args = procRef.arguments();31 std::size_t argSize = args.size();32 if (argSize <= 2)33 return false;34 for (std::size_t i = 2; i < argSize; ++i) {35 if (auto *expr =36 Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(args[i]))37 if (Fortran::evaluate::MayBePassedAsAbsentOptional(*expr))38 return true;39 }40 return false;41}42 43/// Is this a call to ISHFTC intrinsic with a SIZE argument that may be absent44/// at runtime? This is a special case because the SIZE value to be applied45/// when absent is not zero.46static bool isIshftcWithDynamicallyOptionalArg(47 llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef) {48 if (name != "ishftc" || procRef.arguments().size() < 3)49 return false;50 auto *expr = Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(51 procRef.arguments()[2]);52 return expr && Fortran::evaluate::MayBePassedAsAbsentOptional(*expr);53}54 55/// Is this a call to ASSOCIATED where the TARGET is an OPTIONAL (but not a56/// deallocated allocatable or disassociated pointer)?57/// Subtle: contrary to other intrinsic optional arguments, disassociated58/// POINTER and unallocated ALLOCATABLE actual argument are not considered59/// absent here. This is because ASSOCIATED has special requirements for TARGET60/// actual arguments that are POINTERs. There is no precise requirements for61/// ALLOCATABLEs, but all existing Fortran compilers treat them similarly to62/// POINTERs. That is: unallocated TARGETs cause ASSOCIATED to rerun false. The63/// runtime deals with the disassociated/unallocated case. Simply ensures that64/// TARGET that are OPTIONAL get conditionally emboxed here to convey the65/// optional aspect to the runtime.66static bool isAssociatedWithDynamicallyOptionalArg(67 llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef) {68 if (name != "associated" || procRef.arguments().size() < 2)69 return false;70 auto *expr = Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(71 procRef.arguments()[1]);72 const Fortran::semantics::Symbol *sym{73 expr ? Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr)74 : nullptr};75 return (sym && Fortran::semantics::IsOptional(*sym));76}77 78bool Fortran::lower::intrinsicRequiresCustomOptionalHandling(79 const Fortran::evaluate::ProcedureRef &procRef,80 const Fortran::evaluate::SpecificIntrinsic &intrinsic,81 AbstractConverter &converter) {82 llvm::StringRef name = intrinsic.name;83 return isMinOrMaxWithDynamicallyOptionalArg(name, procRef) ||84 isIshftcWithDynamicallyOptionalArg(name, procRef) ||85 isAssociatedWithDynamicallyOptionalArg(name, procRef);86}87 88/// Generate the FIR+MLIR operations for the generic intrinsic \p name89/// with arguments \p args and the expected result type \p resultType.90/// Returned fir::ExtendedValue is the returned Fortran intrinsic value.91fir::ExtendedValue92Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,93 llvm::StringRef name,94 std::optional<mlir::Type> resultType,95 llvm::ArrayRef<fir::ExtendedValue> args,96 Fortran::lower::StatementContext &stmtCtx,97 Fortran::lower::AbstractConverter *converter) {98 auto [result, mustBeFreed] =99 fir::genIntrinsicCall(builder, loc, name, resultType, args, converter);100 if (mustBeFreed) {101 mlir::Value addr = fir::getBase(result);102 if (auto *box = result.getBoxOf<fir::BoxValue>())103 addr =104 fir::BoxAddrOp::create(builder, loc, box->getMemTy(), box->getAddr());105 fir::FirOpBuilder *bldr = &builder;106 stmtCtx.attachCleanup([=]() { fir::FreeMemOp::create(*bldr, loc, addr); });107 }108 return result;109}110 111static void prepareMinOrMaxArguments(112 const Fortran::evaluate::ProcedureRef &procRef,113 const Fortran::evaluate::SpecificIntrinsic &intrinsic,114 std::optional<mlir::Type> retTy,115 const Fortran::lower::OperandPrepare &prepareOptionalArgument,116 const Fortran::lower::OperandPrepareAs &prepareOtherArgument,117 Fortran::lower::AbstractConverter &converter) {118 assert(retTy && "MIN and MAX must have a return type");119 mlir::Type resultType = *retTy;120 mlir::Location loc = converter.getCurrentLocation();121 if (fir::isa_char(resultType))122 TODO(loc, "CHARACTER MIN and MAX with dynamically optional arguments");123 for (auto arg : llvm::enumerate(procRef.arguments())) {124 const auto *expr =125 Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());126 if (!expr)127 continue;128 if (arg.index() <= 1 ||129 !Fortran::evaluate::MayBePassedAsAbsentOptional(*expr)) {130 // Non optional arguments.131 prepareOtherArgument(*expr, fir::LowerIntrinsicArgAs::Value);132 } else {133 // Dynamically optional arguments.134 // Subtle: even for scalar the if-then-else will be generated in the loop135 // nest because the then part will require the current extremum value that136 // may depend on previous array element argument and cannot be outlined.137 prepareOptionalArgument(*expr);138 }139 }140}141 142static fir::ExtendedValue143lowerMinOrMax(fir::FirOpBuilder &builder, mlir::Location loc,144 llvm::StringRef name, std::optional<mlir::Type> retTy,145 const Fortran::lower::OperandPresent &isPresentCheck,146 const Fortran::lower::OperandGetter &getOperand,147 std::size_t numOperands,148 Fortran::lower::StatementContext &stmtCtx) {149 assert(numOperands >= 2 && !isPresentCheck(0) && !isPresentCheck(1) &&150 "min/max must have at least two non-optional args");151 assert(retTy && "MIN and MAX must have a return type");152 mlir::Type resultType = *retTy;153 llvm::SmallVector<fir::ExtendedValue> args;154 const bool loadOperand = true;155 args.push_back(getOperand(0, loadOperand));156 args.push_back(getOperand(1, loadOperand));157 mlir::Value extremum = fir::getBase(158 genIntrinsicCall(builder, loc, name, resultType, args, stmtCtx));159 160 for (std::size_t opIndex = 2; opIndex < numOperands; ++opIndex) {161 if (std::optional<mlir::Value> isPresentRuntimeCheck =162 isPresentCheck(opIndex)) {163 // Argument is dynamically optional.164 extremum =165 builder166 .genIfOp(loc, {resultType}, *isPresentRuntimeCheck,167 /*withElseRegion=*/true)168 .genThen([&]() {169 llvm::SmallVector<fir::ExtendedValue> args;170 args.emplace_back(extremum);171 args.emplace_back(getOperand(opIndex, loadOperand));172 fir::ExtendedValue newExtremum = genIntrinsicCall(173 builder, loc, name, resultType, args, stmtCtx);174 fir::ResultOp::create(builder, loc, fir::getBase(newExtremum));175 })176 .genElse([&]() { fir::ResultOp::create(builder, loc, extremum); })177 .getResults()[0];178 } else {179 // Argument is know to be present at compile time.180 llvm::SmallVector<fir::ExtendedValue> args;181 args.emplace_back(extremum);182 args.emplace_back(getOperand(opIndex, loadOperand));183 extremum = fir::getBase(184 genIntrinsicCall(builder, loc, name, resultType, args, stmtCtx));185 }186 }187 return extremum;188}189 190static void prepareIshftcArguments(191 const Fortran::evaluate::ProcedureRef &procRef,192 const Fortran::evaluate::SpecificIntrinsic &intrinsic,193 std::optional<mlir::Type> retTy,194 const Fortran::lower::OperandPrepare &prepareOptionalArgument,195 const Fortran::lower::OperandPrepareAs &prepareOtherArgument,196 Fortran::lower::AbstractConverter &converter) {197 for (auto arg : llvm::enumerate(procRef.arguments())) {198 const auto *expr =199 Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());200 assert(expr && "expected all ISHFTC argument to be textually present here");201 if (arg.index() == 2) {202 assert(Fortran::evaluate::MayBePassedAsAbsentOptional(*expr) &&203 "expected ISHFTC SIZE arg to be dynamically optional");204 prepareOptionalArgument(*expr);205 } else {206 // Non optional arguments.207 prepareOtherArgument(*expr, fir::LowerIntrinsicArgAs::Value);208 }209 }210}211 212static fir::ExtendedValue213lowerIshftc(fir::FirOpBuilder &builder, mlir::Location loc,214 llvm::StringRef name, std::optional<mlir::Type> retTy,215 const Fortran::lower::OperandPresent &isPresentCheck,216 const Fortran::lower::OperandGetter &getOperand,217 std::size_t numOperands,218 Fortran::lower::StatementContext &stmtCtx) {219 assert(numOperands == 3 && !isPresentCheck(0) && !isPresentCheck(1) &&220 isPresentCheck(2) &&221 "only ISHFTC SIZE arg is expected to be dynamically optional here");222 assert(retTy && "ISFHTC must have a return type");223 mlir::Type resultType = *retTy;224 llvm::SmallVector<fir::ExtendedValue> args;225 const bool loadOperand = true;226 args.push_back(getOperand(0, loadOperand));227 args.push_back(getOperand(1, loadOperand));228 auto iPC = isPresentCheck(2);229 assert(iPC.has_value());230 args.push_back(231 builder232 .genIfOp(loc, {resultType}, *iPC,233 /*withElseRegion=*/true)234 .genThen([&]() {235 fir::ExtendedValue sizeExv = getOperand(2, loadOperand);236 mlir::Value size =237 builder.createConvert(loc, resultType, fir::getBase(sizeExv));238 fir::ResultOp::create(builder, loc, size);239 })240 .genElse([&]() {241 mlir::Value bitSize = builder.createIntegerConstant(242 loc, resultType,243 mlir::cast<mlir::IntegerType>(resultType).getWidth());244 fir::ResultOp::create(builder, loc, bitSize);245 })246 .getResults()[0]);247 return genIntrinsicCall(builder, loc, name, resultType, args, stmtCtx);248}249 250static void prepareAssociatedArguments(251 const Fortran::evaluate::ProcedureRef &procRef,252 const Fortran::evaluate::SpecificIntrinsic &intrinsic,253 std::optional<mlir::Type> retTy,254 const Fortran::lower::OperandPrepare &prepareOptionalArgument,255 const Fortran::lower::OperandPrepareAs &prepareOtherArgument,256 Fortran::lower::AbstractConverter &converter) {257 const auto *pointer = procRef.UnwrapArgExpr(0);258 const auto *optionalTarget = procRef.UnwrapArgExpr(1);259 assert(pointer && optionalTarget &&260 "expected call to associated with a target");261 prepareOtherArgument(*pointer, fir::LowerIntrinsicArgAs::Inquired);262 prepareOptionalArgument(*optionalTarget);263}264 265static fir::ExtendedValue266lowerAssociated(fir::FirOpBuilder &builder, mlir::Location loc,267 llvm::StringRef name, std::optional<mlir::Type> resultType,268 const Fortran::lower::OperandPresent &isPresentCheck,269 const Fortran::lower::OperandGetter &getOperand,270 std::size_t numOperands,271 Fortran::lower::StatementContext &stmtCtx) {272 assert(numOperands == 2 && "expect two arguments when TARGET is OPTIONAL");273 llvm::SmallVector<fir::ExtendedValue> args;274 args.push_back(getOperand(0, /*loadOperand=*/false));275 // Ensure a null descriptor is passed to the code lowering Associated if276 // TARGET is absent.277 fir::ExtendedValue targetExv = getOperand(1, /*loadOperand=*/false);278 mlir::Value targetBase = fir::getBase(targetExv);279 // subtle: isPresentCheck would test for an unallocated/disassociated target,280 // while the optionality of the target pointer/allocatable is what must be281 // checked here.282 mlir::Value isPresent =283 fir::IsPresentOp::create(builder, loc, builder.getI1Type(), targetBase);284 mlir::Type targetType = fir::unwrapRefType(targetBase.getType());285 mlir::Type targetValueType = fir::unwrapPassByRefType(targetType);286 mlir::Type boxType = mlir::isa<fir::BaseBoxType>(targetType)287 ? targetType288 : fir::BoxType::get(targetValueType);289 fir::BoxValue targetBox =290 builder291 .genIfOp(loc, {boxType}, isPresent,292 /*withElseRegion=*/true)293 .genThen([&]() {294 mlir::Value box = builder.createBox(loc, targetExv);295 mlir::Value cast = builder.createConvert(loc, boxType, box);296 fir::ResultOp::create(builder, loc, cast);297 })298 .genElse([&]() {299 mlir::Value absentBox =300 fir::AbsentOp::create(builder, loc, boxType);301 fir::ResultOp::create(builder, loc, absentBox);302 })303 .getResults()[0];304 args.emplace_back(std::move(targetBox));305 return genIntrinsicCall(builder, loc, name, resultType, args, stmtCtx);306}307 308void Fortran::lower::prepareCustomIntrinsicArgument(309 const Fortran::evaluate::ProcedureRef &procRef,310 const Fortran::evaluate::SpecificIntrinsic &intrinsic,311 std::optional<mlir::Type> retTy,312 const OperandPrepare &prepareOptionalArgument,313 const OperandPrepareAs &prepareOtherArgument,314 AbstractConverter &converter) {315 llvm::StringRef name = intrinsic.name;316 if (name == "min" || name == "max")317 return prepareMinOrMaxArguments(procRef, intrinsic, retTy,318 prepareOptionalArgument,319 prepareOtherArgument, converter);320 if (name == "associated")321 return prepareAssociatedArguments(procRef, intrinsic, retTy,322 prepareOptionalArgument,323 prepareOtherArgument, converter);324 assert(name == "ishftc" && "unexpected custom intrinsic argument call");325 return prepareIshftcArguments(procRef, intrinsic, retTy,326 prepareOptionalArgument, prepareOtherArgument,327 converter);328}329 330fir::ExtendedValue Fortran::lower::lowerCustomIntrinsic(331 fir::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name,332 std::optional<mlir::Type> retTy, const OperandPresent &isPresentCheck,333 const OperandGetter &getOperand, std::size_t numOperands,334 Fortran::lower::StatementContext &stmtCtx) {335 if (name == "min" || name == "max")336 return lowerMinOrMax(builder, loc, name, retTy, isPresentCheck, getOperand,337 numOperands, stmtCtx);338 if (name == "associated")339 return lowerAssociated(builder, loc, name, retTy, isPresentCheck,340 getOperand, numOperands, stmtCtx);341 assert(name == "ishftc" && "unexpected custom intrinsic call");342 return lowerIshftc(builder, loc, name, retTy, isPresentCheck, getOperand,343 numOperands, stmtCtx);344}345