1 //===- ConvertProcedureDesignator.cpp -- Procedure Designator ---*- C++ -*-===// 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-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #include "flang/Lower/ConvertProcedureDesignator.h" 10 #include "flang/Evaluate/intrinsics.h" 11 #include "flang/Lower/AbstractConverter.h" 12 #include "flang/Lower/CallInterface.h" 13 #include "flang/Lower/ConvertCall.h" 14 #include "flang/Lower/ConvertVariable.h" 15 #include "flang/Lower/Support/Utils.h" 16 #include "flang/Lower/SymbolMap.h" 17 #include "flang/Optimizer/Builder/Character.h" 18 #include "flang/Optimizer/Builder/IntrinsicCall.h" 19 #include "flang/Optimizer/Dialect/FIROps.h" 20 21 static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr, 22 Fortran::lower::SymMap &symMap) { 23 for (const auto &sym : Fortran::evaluate::CollectSymbols(expr)) 24 if (!symMap.lookupSymbol(sym)) 25 return false; 26 return true; 27 } 28 29 fir::ExtendedValue Fortran::lower::convertProcedureDesignator( 30 mlir::Location loc, Fortran::lower::AbstractConverter &converter, 31 const Fortran::evaluate::ProcedureDesignator &proc, 32 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { 33 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 34 35 if (const Fortran::evaluate::SpecificIntrinsic *intrinsic = 36 proc.GetSpecificIntrinsic()) { 37 mlir::FunctionType signature = 38 Fortran::lower::translateSignature(proc, converter); 39 // Intrinsic lowering is based on the generic name, so retrieve it here in 40 // case it is different from the specific name. The type of the specific 41 // intrinsic is retained in the signature. 42 std::string genericName = 43 converter.getFoldingContext().intrinsics().GetGenericIntrinsicName( 44 intrinsic->name); 45 mlir::SymbolRefAttr symbolRefAttr = 46 fir::getUnrestrictedIntrinsicSymbolRefAttr(builder, loc, genericName, 47 signature); 48 mlir::Value funcPtr = 49 builder.create<fir::AddrOfOp>(loc, signature, symbolRefAttr); 50 return funcPtr; 51 } 52 const Fortran::semantics::Symbol *symbol = proc.GetSymbol(); 53 assert(symbol && "expected symbol in ProcedureDesignator"); 54 mlir::Value funcPtr; 55 mlir::Value funcPtrResultLength; 56 if (Fortran::semantics::IsDummy(*symbol)) { 57 Fortran::lower::SymbolBox val = symMap.lookupSymbol(*symbol); 58 assert(val && "Dummy procedure not in symbol map"); 59 funcPtr = val.getAddr(); 60 if (fir::isCharacterProcedureTuple(funcPtr.getType(), 61 /*acceptRawFunc=*/false)) 62 std::tie(funcPtr, funcPtrResultLength) = 63 fir::factory::extractCharacterProcedureTuple(builder, loc, funcPtr); 64 } else { 65 mlir::func::FuncOp func = 66 Fortran::lower::getOrDeclareFunction(proc, converter); 67 mlir::SymbolRefAttr nameAttr = builder.getSymbolRefAttr(func.getSymName()); 68 funcPtr = 69 builder.create<fir::AddrOfOp>(loc, func.getFunctionType(), nameAttr); 70 } 71 if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) { 72 // The result length, if available here, must be propagated along the 73 // procedure address so that call sites where the result length is assumed 74 // can retrieve the length. 75 Fortran::evaluate::DynamicType resultType = proc.GetType().value(); 76 if (const auto &lengthExpr = resultType.GetCharLength()) { 77 // The length expression may refer to dummy argument symbols that are 78 // meaningless without any actual arguments. Leave the length as 79 // unknown in that case, it be resolved on the call site 80 // with the actual arguments. 81 if (areAllSymbolsInExprMapped(*lengthExpr, symMap)) { 82 mlir::Value rawLen = fir::getBase( 83 converter.genExprValue(toEvExpr(*lengthExpr), stmtCtx)); 84 // F2018 7.4.4.2 point 5. 85 funcPtrResultLength = 86 fir::factory::genMaxWithZero(builder, loc, rawLen); 87 } 88 } 89 if (!funcPtrResultLength) 90 funcPtrResultLength = builder.createIntegerConstant( 91 loc, builder.getCharacterLengthType(), -1); 92 return fir::CharBoxValue{funcPtr, funcPtrResultLength}; 93 } 94 return funcPtr; 95 } 96 97 hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR( 98 mlir::Location loc, Fortran::lower::AbstractConverter &converter, 99 const Fortran::evaluate::ProcedureDesignator &proc, 100 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { 101 fir::ExtendedValue procExv = 102 convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx); 103 // Directly package the procedure address as a fir.boxproc or 104 // tuple<fir.boxbroc, len> so that it can be returned as a single mlir::Value. 105 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 106 107 mlir::Value funcAddr = fir::getBase(procExv); 108 if (!funcAddr.getType().isa<fir::BoxProcType>()) { 109 mlir::Type boxTy = 110 Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext()); 111 if (auto host = Fortran::lower::argumentHostAssocs(converter, funcAddr)) 112 funcAddr = builder.create<fir::EmboxProcOp>( 113 loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host}); 114 else 115 funcAddr = builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr); 116 } 117 118 mlir::Value res = procExv.match( 119 [&](const fir::CharBoxValue &box) -> mlir::Value { 120 mlir::Type tupleTy = 121 fir::factory::getCharacterProcedureTupleType(funcAddr.getType()); 122 return fir::factory::createCharacterProcedureTuple( 123 builder, loc, tupleTy, funcAddr, box.getLen()); 124 }, 125 [funcAddr](const auto &) { return funcAddr; }); 126 return hlfir::EntityWithAttributes{res}; 127 } 128