18c22cb84SValentin Clement //===-- IO.cpp -- IO statement lowering -----------------------------------===// 28c22cb84SValentin Clement // 38c22cb84SValentin Clement // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 48c22cb84SValentin Clement // See https://llvm.org/LICENSE.txt for license information. 58c22cb84SValentin Clement // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 68c22cb84SValentin Clement // 78c22cb84SValentin Clement //===----------------------------------------------------------------------===// 88c22cb84SValentin Clement // 98c22cb84SValentin Clement // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ 108c22cb84SValentin Clement // 118c22cb84SValentin Clement //===----------------------------------------------------------------------===// 128c22cb84SValentin Clement 138c22cb84SValentin Clement #include "flang/Lower/IO.h" 148c22cb84SValentin Clement #include "flang/Common/uint128.h" 15c0185c8dSValentin Clement #include "flang/Evaluate/tools.h" 169aeb7f03SValentin Clement #include "flang/Lower/Allocatable.h" 178c22cb84SValentin Clement #include "flang/Lower/Bridge.h" 186f7a3b07SV Donaldson #include "flang/Lower/CallInterface.h" 199aeb7f03SValentin Clement #include "flang/Lower/ConvertExpr.h" 208c22cb84SValentin Clement #include "flang/Lower/ConvertVariable.h" 21518e6f12SV Donaldson #include "flang/Lower/Mangler.h" 228c22cb84SValentin Clement #include "flang/Lower/PFTBuilder.h" 239aeb7f03SValentin Clement #include "flang/Lower/Runtime.h" 248c22cb84SValentin Clement #include "flang/Lower/StatementContext.h" 258c22cb84SValentin Clement #include "flang/Lower/Support/Utils.h" 269aeb7f03SValentin Clement #include "flang/Lower/VectorSubscripts.h" 278c22cb84SValentin Clement #include "flang/Optimizer/Builder/Character.h" 288c22cb84SValentin Clement #include "flang/Optimizer/Builder/Complex.h" 298c22cb84SValentin Clement #include "flang/Optimizer/Builder/FIRBuilder.h" 308c22cb84SValentin Clement #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" 311fd72321SV Donaldson #include "flang/Optimizer/Builder/Runtime/Stop.h" 325b66cc10SValentin Clement #include "flang/Optimizer/Builder/Todo.h" 33ff794116SSlava Zakharin #include "flang/Optimizer/Dialect/FIRDialect.h" 34b07ef9e7SRenaud-K #include "flang/Optimizer/Dialect/Support/FIRContext.h" 35*3e13acfbSValentin Clement (バレンタイン クレメン) #include "flang/Optimizer/Support/InternalNames.h" 368c22cb84SValentin Clement #include "flang/Parser/parse-tree.h" 37c91ba043SMichael Kruse #include "flang/Runtime/io-api-consts.h" 386f7a3b07SV Donaldson #include "flang/Semantics/runtime-type-info.h" 398c22cb84SValentin Clement #include "flang/Semantics/tools.h" 408c22cb84SValentin Clement #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h" 411bffc753SEric Schweitz #include "llvm/Support/Debug.h" 424d4d4785SKazu Hirata #include <optional> 438c22cb84SValentin Clement 448c22cb84SValentin Clement #define DEBUG_TYPE "flang-lower-io" 458c22cb84SValentin Clement 468c22cb84SValentin Clement // Define additional runtime type models specific to IO. 478c22cb84SValentin Clement namespace fir::runtime { 488c22cb84SValentin Clement template <> 498c22cb84SValentin Clement constexpr TypeBuilderFunc getModel<Fortran::runtime::io::IoStatementState *>() { 508c22cb84SValentin Clement return getModel<char *>(); 518c22cb84SValentin Clement } 528c22cb84SValentin Clement template <> 536f7a3b07SV Donaldson constexpr TypeBuilderFunc getModel<Fortran::runtime::io::Iostat>() { 546f7a3b07SV Donaldson return [](mlir::MLIRContext *context) -> mlir::Type { 556f7a3b07SV Donaldson return mlir::IntegerType::get(context, 566f7a3b07SV Donaldson 8 * sizeof(Fortran::runtime::io::Iostat)); 576f7a3b07SV Donaldson }; 586f7a3b07SV Donaldson } 596f7a3b07SV Donaldson template <> 608c22cb84SValentin Clement constexpr TypeBuilderFunc 618c22cb84SValentin Clement getModel<const Fortran::runtime::io::NamelistGroup &>() { 628c22cb84SValentin Clement return [](mlir::MLIRContext *context) -> mlir::Type { 638c22cb84SValentin Clement return fir::ReferenceType::get(mlir::TupleType::get(context)); 648c22cb84SValentin Clement }; 658c22cb84SValentin Clement } 668c22cb84SValentin Clement template <> 676f7a3b07SV Donaldson constexpr TypeBuilderFunc 686f7a3b07SV Donaldson getModel<const Fortran::runtime::io::NonTbpDefinedIoTable *>() { 698c22cb84SValentin Clement return [](mlir::MLIRContext *context) -> mlir::Type { 706f7a3b07SV Donaldson return fir::ReferenceType::get(mlir::TupleType::get(context)); 718c22cb84SValentin Clement }; 728c22cb84SValentin Clement } 738c22cb84SValentin Clement } // namespace fir::runtime 748c22cb84SValentin Clement 758c22cb84SValentin Clement using namespace Fortran::runtime::io; 768c22cb84SValentin Clement 778c22cb84SValentin Clement #define mkIOKey(X) FirmkKey(IONAME(X)) 788c22cb84SValentin Clement 798c22cb84SValentin Clement namespace Fortran::lower { 808c22cb84SValentin Clement /// Static table of IO runtime calls 818c22cb84SValentin Clement /// 828c22cb84SValentin Clement /// This logical map contains the name and type builder function for each IO 838c22cb84SValentin Clement /// runtime function listed in the tuple. This table is fully constructed at 848c22cb84SValentin Clement /// compile-time. Use the `mkIOKey` macro to access the table. 858c22cb84SValentin Clement static constexpr std::tuple< 866f7a3b07SV Donaldson mkIOKey(BeginBackspace), mkIOKey(BeginClose), mkIOKey(BeginEndfile), 876f7a3b07SV Donaldson mkIOKey(BeginExternalFormattedInput), mkIOKey(BeginExternalFormattedOutput), 886f7a3b07SV Donaldson mkIOKey(BeginExternalListInput), mkIOKey(BeginExternalListOutput), 896f7a3b07SV Donaldson mkIOKey(BeginFlush), mkIOKey(BeginInquireFile), 906f7a3b07SV Donaldson mkIOKey(BeginInquireIoLength), mkIOKey(BeginInquireUnit), 916f7a3b07SV Donaldson mkIOKey(BeginInternalArrayFormattedInput), 928c22cb84SValentin Clement mkIOKey(BeginInternalArrayFormattedOutput), 936f7a3b07SV Donaldson mkIOKey(BeginInternalArrayListInput), mkIOKey(BeginInternalArrayListOutput), 946f7a3b07SV Donaldson mkIOKey(BeginInternalFormattedInput), mkIOKey(BeginInternalFormattedOutput), 956f7a3b07SV Donaldson mkIOKey(BeginInternalListInput), mkIOKey(BeginInternalListOutput), 966f7a3b07SV Donaldson mkIOKey(BeginOpenNewUnit), mkIOKey(BeginOpenUnit), mkIOKey(BeginRewind), 976f7a3b07SV Donaldson mkIOKey(BeginUnformattedInput), mkIOKey(BeginUnformattedOutput), 986f7a3b07SV Donaldson mkIOKey(BeginWait), mkIOKey(BeginWaitAll), 991bffc753SEric Schweitz mkIOKey(CheckUnitNumberInRange64), mkIOKey(CheckUnitNumberInRange128), 1004679132aSjeanPerier mkIOKey(EnableHandlers), mkIOKey(EndIoStatement), 1014679132aSjeanPerier mkIOKey(GetAsynchronousId), mkIOKey(GetIoLength), mkIOKey(GetIoMsg), 1024679132aSjeanPerier mkIOKey(GetNewUnit), mkIOKey(GetSize), mkIOKey(InputAscii), 1034679132aSjeanPerier mkIOKey(InputComplex32), mkIOKey(InputComplex64), mkIOKey(InputDerivedType), 1044679132aSjeanPerier mkIOKey(InputDescriptor), mkIOKey(InputInteger), mkIOKey(InputLogical), 1054679132aSjeanPerier mkIOKey(InputNamelist), mkIOKey(InputReal32), mkIOKey(InputReal64), 1064679132aSjeanPerier mkIOKey(InquireCharacter), mkIOKey(InquireInteger64), 1076f7a3b07SV Donaldson mkIOKey(InquireLogical), mkIOKey(InquirePendingId), mkIOKey(OutputAscii), 1086f7a3b07SV Donaldson mkIOKey(OutputComplex32), mkIOKey(OutputComplex64), 1096f7a3b07SV Donaldson mkIOKey(OutputDerivedType), mkIOKey(OutputDescriptor), 1106f7a3b07SV Donaldson mkIOKey(OutputInteger8), mkIOKey(OutputInteger16), mkIOKey(OutputInteger32), 1116f7a3b07SV Donaldson mkIOKey(OutputInteger64), mkIOKey(OutputInteger128), mkIOKey(OutputLogical), 1126f7a3b07SV Donaldson mkIOKey(OutputNamelist), mkIOKey(OutputReal32), mkIOKey(OutputReal64), 1138cf6e940Skkwli mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAdvance), 1148cf6e940Skkwli mkIOKey(SetAsynchronous), mkIOKey(SetBlank), mkIOKey(SetCarriagecontrol), 1158cf6e940Skkwli mkIOKey(SetConvert), mkIOKey(SetDecimal), mkIOKey(SetDelim), 1168cf6e940Skkwli mkIOKey(SetEncoding), mkIOKey(SetFile), mkIOKey(SetForm), mkIOKey(SetPad), 1178cf6e940Skkwli mkIOKey(SetPos), mkIOKey(SetPosition), mkIOKey(SetRec), mkIOKey(SetRecl), 1188cf6e940Skkwli mkIOKey(SetRound), mkIOKey(SetSign), mkIOKey(SetStatus)> 1198c22cb84SValentin Clement newIOTable; 1208c22cb84SValentin Clement } // namespace Fortran::lower 1218c22cb84SValentin Clement 1228c22cb84SValentin Clement namespace { 1238c22cb84SValentin Clement /// IO statements may require exceptional condition handling. A statement that 1248c22cb84SValentin Clement /// encounters an exceptional condition may branch to a label given on an ERR 1258c22cb84SValentin Clement /// (error), END (end-of-file), or EOR (end-of-record) specifier. An IOSTAT 1268c22cb84SValentin Clement /// specifier variable may be set to a value that indicates some condition, 1278c22cb84SValentin Clement /// and an IOMSG specifier variable may be set to a description of a condition. 1288c22cb84SValentin Clement struct ConditionSpecInfo { 1298c22cb84SValentin Clement const Fortran::lower::SomeExpr *ioStatExpr{}; 130c0921586SKazu Hirata std::optional<fir::ExtendedValue> ioMsg; 1318c22cb84SValentin Clement bool hasErr{}; 1328c22cb84SValentin Clement bool hasEnd{}; 1338c22cb84SValentin Clement bool hasEor{}; 1341bffc753SEric Schweitz fir::IfOp bigUnitIfOp; 1358c22cb84SValentin Clement 1368c22cb84SValentin Clement /// Check for any condition specifier that applies to specifier processing. 1378c22cb84SValentin Clement bool hasErrorConditionSpec() const { return ioStatExpr != nullptr || hasErr; } 1388c22cb84SValentin Clement 1398c22cb84SValentin Clement /// Check for any condition specifier that applies to data transfer items 1408c22cb84SValentin Clement /// in a PRINT, READ, WRITE, or WAIT statement. (WAIT may be irrelevant.) 1418c22cb84SValentin Clement bool hasTransferConditionSpec() const { 1428c22cb84SValentin Clement return hasErrorConditionSpec() || hasEnd || hasEor; 1438c22cb84SValentin Clement } 1448c22cb84SValentin Clement 1458c22cb84SValentin Clement /// Check for any condition specifier, including IOMSG. 1468c22cb84SValentin Clement bool hasAnyConditionSpec() const { 1471bffc753SEric Schweitz return hasTransferConditionSpec() || ioMsg; 1488c22cb84SValentin Clement } 1498c22cb84SValentin Clement }; 1508c22cb84SValentin Clement } // namespace 1518c22cb84SValentin Clement 1528c22cb84SValentin Clement template <typename D> 1538c22cb84SValentin Clement static void genIoLoop(Fortran::lower::AbstractConverter &converter, 1548c22cb84SValentin Clement mlir::Value cookie, const D &ioImpliedDo, 1558c22cb84SValentin Clement bool isFormatted, bool checkResult, mlir::Value &ok, 1561bffc753SEric Schweitz bool inLoop); 1578c22cb84SValentin Clement 1588c22cb84SValentin Clement /// Helper function to retrieve the name of the IO function given the key `A` 1598c22cb84SValentin Clement template <typename A> 1608c22cb84SValentin Clement static constexpr const char *getName() { 1618c22cb84SValentin Clement return std::get<A>(Fortran::lower::newIOTable).name; 1628c22cb84SValentin Clement } 1638c22cb84SValentin Clement 1648c22cb84SValentin Clement /// Helper function to retrieve the type model signature builder of the IO 1658c22cb84SValentin Clement /// function as defined by the key `A` 1668c22cb84SValentin Clement template <typename A> 1678c22cb84SValentin Clement static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() { 1688c22cb84SValentin Clement return std::get<A>(Fortran::lower::newIOTable).getTypeModel(); 1698c22cb84SValentin Clement } 1708c22cb84SValentin Clement 1719aeb7f03SValentin Clement inline int64_t getLength(mlir::Type argTy) { 172fac349a1SChristian Sigg return mlir::cast<fir::SequenceType>(argTy).getShape()[0]; 1739aeb7f03SValentin Clement } 1749aeb7f03SValentin Clement 1758c22cb84SValentin Clement /// Get (or generate) the MLIR FuncOp for a given IO runtime function. 1768c22cb84SValentin Clement template <typename E> 17758ceae95SRiver Riddle static mlir::func::FuncOp getIORuntimeFunc(mlir::Location loc, 1788c22cb84SValentin Clement fir::FirOpBuilder &builder) { 1798c22cb84SValentin Clement llvm::StringRef name = getName<E>(); 1801c7889caSValentin Clement mlir::func::FuncOp func = builder.getNamedFunction(name); 1818c22cb84SValentin Clement if (func) 1828c22cb84SValentin Clement return func; 1838c22cb84SValentin Clement auto funTy = getTypeModel<E>()(builder.getContext()); 1848c22cb84SValentin Clement func = builder.createFunction(loc, name, funTy); 185ff794116SSlava Zakharin func->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(), 186ff794116SSlava Zakharin builder.getUnitAttr()); 1878c22cb84SValentin Clement func->setAttr("fir.io", builder.getUnitAttr()); 1888c22cb84SValentin Clement return func; 1898c22cb84SValentin Clement } 1908c22cb84SValentin Clement 1918c22cb84SValentin Clement /// Generate calls to end an IO statement. Return the IOSTAT value, if any. 1928c22cb84SValentin Clement /// It is the caller's responsibility to generate branches on that value. 1938c22cb84SValentin Clement static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter, 1948c22cb84SValentin Clement mlir::Location loc, mlir::Value cookie, 1951bffc753SEric Schweitz ConditionSpecInfo &csi, 1968c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 1978c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 1981bffc753SEric Schweitz if (csi.ioMsg) { 1991c7889caSValentin Clement mlir::func::FuncOp getIoMsg = 2001c7889caSValentin Clement getIORuntimeFunc<mkIOKey(GetIoMsg)>(loc, builder); 2018c22cb84SValentin Clement builder.create<fir::CallOp>( 2028c22cb84SValentin Clement loc, getIoMsg, 2038c22cb84SValentin Clement mlir::ValueRange{ 2048c22cb84SValentin Clement cookie, 2054a3460a7SRiver Riddle builder.createConvert(loc, getIoMsg.getFunctionType().getInput(1), 2061bffc753SEric Schweitz fir::getBase(*csi.ioMsg)), 2074a3460a7SRiver Riddle builder.createConvert(loc, getIoMsg.getFunctionType().getInput(2), 2081bffc753SEric Schweitz fir::getLen(*csi.ioMsg))}); 2098c22cb84SValentin Clement } 2101c7889caSValentin Clement mlir::func::FuncOp endIoStatement = 2111c7889caSValentin Clement getIORuntimeFunc<mkIOKey(EndIoStatement)>(loc, builder); 2128c22cb84SValentin Clement auto call = builder.create<fir::CallOp>(loc, endIoStatement, 2138c22cb84SValentin Clement mlir::ValueRange{cookie}); 2141bffc753SEric Schweitz mlir::Value iostat = call.getResult(0); 2151bffc753SEric Schweitz if (csi.bigUnitIfOp) { 2161e55ec66SValentin Clement stmtCtx.finalizeAndPop(); 2171bffc753SEric Schweitz builder.create<fir::ResultOp>(loc, iostat); 2181bffc753SEric Schweitz builder.setInsertionPointAfter(csi.bigUnitIfOp); 2191bffc753SEric Schweitz iostat = csi.bigUnitIfOp.getResult(0); 2201bffc753SEric Schweitz } 2218c22cb84SValentin Clement if (csi.ioStatExpr) { 2228c22cb84SValentin Clement mlir::Value ioStatVar = 2231bffc753SEric Schweitz fir::getBase(converter.genExprAddr(loc, csi.ioStatExpr, stmtCtx)); 2241bffc753SEric Schweitz mlir::Value ioStatResult = 2251bffc753SEric Schweitz builder.createConvert(loc, converter.genType(*csi.ioStatExpr), iostat); 2268c22cb84SValentin Clement builder.create<fir::StoreOp>(loc, ioStatResult, ioStatVar); 2278c22cb84SValentin Clement } 2281bffc753SEric Schweitz return csi.hasTransferConditionSpec() ? iostat : mlir::Value{}; 2298c22cb84SValentin Clement } 2308c22cb84SValentin Clement 2318c22cb84SValentin Clement /// Make the next call in the IO statement conditional on runtime result `ok`. 2328c22cb84SValentin Clement /// If a call returns `ok==false`, further suboperation calls for an IO 2338c22cb84SValentin Clement /// statement will be skipped. This may generate branch heavy, deeply nested 2348c22cb84SValentin Clement /// conditionals for IO statements with a large number of suboperations. 2358c22cb84SValentin Clement static void makeNextConditionalOn(fir::FirOpBuilder &builder, 2368c22cb84SValentin Clement mlir::Location loc, bool checkResult, 2378c22cb84SValentin Clement mlir::Value ok, bool inLoop = false) { 2388c22cb84SValentin Clement if (!checkResult || !ok) 2398c22cb84SValentin Clement // Either no IO calls need to be checked, or this will be the first call. 2408c22cb84SValentin Clement return; 2418c22cb84SValentin Clement 2428c22cb84SValentin Clement // A previous IO call for a statement returned the bool `ok`. If this call 2438c22cb84SValentin Clement // is in a fir.iterate_while loop, the result must be propagated up to the 2448c22cb84SValentin Clement // loop scope as an extra ifOp result. (The propagation is done in genIoLoop.) 2458c22cb84SValentin Clement mlir::TypeRange resTy; 246629afd4dSKrzysztof Parzyszek // TypeRange does not own its contents, so make sure the the type object 247629afd4dSKrzysztof Parzyszek // is live until the end of the function. 248629afd4dSKrzysztof Parzyszek mlir::IntegerType boolTy = builder.getI1Type(); 2498c22cb84SValentin Clement if (inLoop) 250629afd4dSKrzysztof Parzyszek resTy = boolTy; 2518c22cb84SValentin Clement auto ifOp = builder.create<fir::IfOp>(loc, resTy, ok, 2528c22cb84SValentin Clement /*withElseRegion=*/inLoop); 2538c22cb84SValentin Clement builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 2548c22cb84SValentin Clement } 2558c22cb84SValentin Clement 2566f7a3b07SV Donaldson // Derived type symbols may each be mapped to up to 4 defined IO procedures. 2576f7a3b07SV Donaldson using DefinedIoProcMap = std::multimap<const Fortran::semantics::Symbol *, 2586f7a3b07SV Donaldson Fortran::semantics::NonTbpDefinedIo>; 2596f7a3b07SV Donaldson 2606f7a3b07SV Donaldson /// Get the current scope's non-type-bound defined IO procedures. 2616f7a3b07SV Donaldson static DefinedIoProcMap 2626f7a3b07SV Donaldson getDefinedIoProcMap(Fortran::lower::AbstractConverter &converter) { 2636f7a3b07SV Donaldson const Fortran::semantics::Scope *scope = &converter.getCurrentScope(); 2646f7a3b07SV Donaldson for (; !scope->IsGlobal(); scope = &scope->parent()) 2656f7a3b07SV Donaldson if (scope->kind() == Fortran::semantics::Scope::Kind::MainProgram || 2666f7a3b07SV Donaldson scope->kind() == Fortran::semantics::Scope::Kind::Subprogram || 2676f7a3b07SV Donaldson scope->kind() == Fortran::semantics::Scope::Kind::BlockConstruct) 2686f7a3b07SV Donaldson break; 2696f7a3b07SV Donaldson return Fortran::semantics::CollectNonTbpDefinedIoGenericInterfaces(*scope, 2706f7a3b07SV Donaldson false); 2716f7a3b07SV Donaldson } 2726f7a3b07SV Donaldson 2736f7a3b07SV Donaldson /// Check a set of defined IO procedures for any procedure pointer or dummy 2746f7a3b07SV Donaldson /// procedures. 2756f7a3b07SV Donaldson static bool hasLocalDefinedIoProc(DefinedIoProcMap &definedIoProcMap) { 2766f7a3b07SV Donaldson for (auto &iface : definedIoProcMap) { 2776f7a3b07SV Donaldson const Fortran::semantics::Symbol *procSym = iface.second.subroutine; 2786f7a3b07SV Donaldson if (!procSym) 2796f7a3b07SV Donaldson continue; 2806f7a3b07SV Donaldson procSym = &procSym->GetUltimate(); 2816f7a3b07SV Donaldson if (Fortran::semantics::IsProcedurePointer(*procSym) || 2826f7a3b07SV Donaldson Fortran::semantics::IsDummy(*procSym)) 2836f7a3b07SV Donaldson return true; 2846f7a3b07SV Donaldson } 2856f7a3b07SV Donaldson return false; 2866f7a3b07SV Donaldson } 2876f7a3b07SV Donaldson 2886f7a3b07SV Donaldson /// Retrieve or generate a runtime description of the non-type-bound defined 2896f7a3b07SV Donaldson /// IO procedures in the current scope. If any procedure is a dummy or a 2906f7a3b07SV Donaldson /// procedure pointer, the result is local. Otherwise the result is static. 2916f7a3b07SV Donaldson /// If there are no procedures, return a scope-independent default table with 2926f7a3b07SV Donaldson /// an empty procedure list, but with the `ignoreNonTbpEntries` flag set. The 2936f7a3b07SV Donaldson /// form of the description is defined in runtime header file non-tbp-dio.h. 2946f7a3b07SV Donaldson static mlir::Value 2956f7a3b07SV Donaldson getNonTbpDefinedIoTableAddr(Fortran::lower::AbstractConverter &converter, 2966f7a3b07SV Donaldson DefinedIoProcMap &definedIoProcMap) { 2976f7a3b07SV Donaldson fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 2986f7a3b07SV Donaldson mlir::MLIRContext *context = builder.getContext(); 2996f7a3b07SV Donaldson mlir::Location loc = converter.getCurrentLocation(); 3006f7a3b07SV Donaldson mlir::Type refTy = fir::ReferenceType::get(mlir::NoneType::get(context)); 3016f7a3b07SV Donaldson std::string suffix = ".nonTbpDefinedIoTable"; 302*3e13acfbSValentin Clement (バレンタイン クレメン) std::string tableMangleName = 303*3e13acfbSValentin Clement (バレンタイン クレメン) definedIoProcMap.empty() 304*3e13acfbSValentin Clement (バレンタイン クレメン) ? fir::NameUniquer::doGenerated("default" + suffix) 3056f7a3b07SV Donaldson : converter.mangleName(suffix); 3066f7a3b07SV Donaldson if (auto table = builder.getNamedGlobal(tableMangleName)) 3076f7a3b07SV Donaldson return builder.createConvert( 3086f7a3b07SV Donaldson loc, refTy, 3096f7a3b07SV Donaldson builder.create<fir::AddrOfOp>(loc, table.resultType(), 3106f7a3b07SV Donaldson table.getSymbol())); 3116f7a3b07SV Donaldson 3126f7a3b07SV Donaldson mlir::StringAttr linkOnce = builder.createLinkOnceLinkage(); 3136f7a3b07SV Donaldson mlir::Type idxTy = builder.getIndexType(); 3146f7a3b07SV Donaldson mlir::Type sizeTy = 3156f7a3b07SV Donaldson fir::runtime::getModel<std::size_t>()(builder.getContext()); 3166f7a3b07SV Donaldson mlir::Type intTy = fir::runtime::getModel<int>()(builder.getContext()); 3176f7a3b07SV Donaldson mlir::Type boolTy = fir::runtime::getModel<bool>()(builder.getContext()); 3186f7a3b07SV Donaldson mlir::Type listTy = fir::SequenceType::get( 3196f7a3b07SV Donaldson definedIoProcMap.size(), 3206f7a3b07SV Donaldson mlir::TupleType::get(context, {refTy, refTy, intTy, boolTy})); 3216f7a3b07SV Donaldson mlir::Type tableTy = mlir::TupleType::get( 3226f7a3b07SV Donaldson context, {sizeTy, fir::ReferenceType::get(listTy), boolTy}); 3236f7a3b07SV Donaldson 3246f7a3b07SV Donaldson // Define the list of NonTbpDefinedIo procedures. 3256f7a3b07SV Donaldson bool tableIsLocal = 3266f7a3b07SV Donaldson !definedIoProcMap.empty() && hasLocalDefinedIoProc(definedIoProcMap); 3276f7a3b07SV Donaldson mlir::Value listAddr = 3286f7a3b07SV Donaldson tableIsLocal ? builder.create<fir::AllocaOp>(loc, listTy) : mlir::Value{}; 3296f7a3b07SV Donaldson std::string listMangleName = tableMangleName + ".list"; 3306f7a3b07SV Donaldson auto listFunc = [&](fir::FirOpBuilder &builder) { 3316f7a3b07SV Donaldson mlir::Value list = builder.create<fir::UndefOp>(loc, listTy); 3326f7a3b07SV Donaldson mlir::IntegerAttr intAttr[4]; 3336f7a3b07SV Donaldson for (int i = 0; i < 4; ++i) 3346f7a3b07SV Donaldson intAttr[i] = builder.getIntegerAttr(idxTy, i); 3356f7a3b07SV Donaldson llvm::SmallVector<mlir::Attribute, 2> idx = {mlir::Attribute{}, 3366f7a3b07SV Donaldson mlir::Attribute{}}; 3376f7a3b07SV Donaldson int n0 = 0, n1; 3386f7a3b07SV Donaldson auto insert = [&](mlir::Value val) { 3396f7a3b07SV Donaldson idx[1] = intAttr[n1++]; 3406f7a3b07SV Donaldson list = builder.create<fir::InsertValueOp>(loc, listTy, list, val, 3416f7a3b07SV Donaldson builder.getArrayAttr(idx)); 3426f7a3b07SV Donaldson }; 3436f7a3b07SV Donaldson for (auto &iface : definedIoProcMap) { 3446f7a3b07SV Donaldson idx[0] = builder.getIntegerAttr(idxTy, n0++); 3456f7a3b07SV Donaldson n1 = 0; 3466f7a3b07SV Donaldson // derived type description [const typeInfo::DerivedType &derivedType] 3476f7a3b07SV Donaldson const Fortran::semantics::Symbol &dtSym = iface.first->GetUltimate(); 3486f7a3b07SV Donaldson std::string dtName = converter.mangleName(dtSym); 3496f7a3b07SV Donaldson insert(builder.createConvert( 3506f7a3b07SV Donaldson loc, refTy, 3516f7a3b07SV Donaldson builder.create<fir::AddrOfOp>( 3526f7a3b07SV Donaldson loc, fir::ReferenceType::get(converter.genType(dtSym)), 3536f7a3b07SV Donaldson builder.getSymbolRefAttr(dtName)))); 3546f7a3b07SV Donaldson // defined IO procedure [void (*subroutine)()], may be null 3556f7a3b07SV Donaldson const Fortran::semantics::Symbol *procSym = iface.second.subroutine; 3566f7a3b07SV Donaldson if (procSym) { 3576f7a3b07SV Donaldson procSym = &procSym->GetUltimate(); 3586f7a3b07SV Donaldson if (Fortran::semantics::IsProcedurePointer(*procSym)) { 3596f7a3b07SV Donaldson TODO(loc, "defined IO procedure pointers"); 3606f7a3b07SV Donaldson } else if (Fortran::semantics::IsDummy(*procSym)) { 3616f7a3b07SV Donaldson Fortran::lower::StatementContext stmtCtx; 3626f7a3b07SV Donaldson insert(builder.create<fir::BoxAddrOp>( 3636f7a3b07SV Donaldson loc, refTy, 3646f7a3b07SV Donaldson fir::getBase(converter.genExprAddr( 3656f7a3b07SV Donaldson loc, 3666f7a3b07SV Donaldson Fortran::lower::SomeExpr{ 3676f7a3b07SV Donaldson Fortran::evaluate::ProcedureDesignator{*procSym}}, 3686f7a3b07SV Donaldson stmtCtx)))); 3696f7a3b07SV Donaldson } else { 37088684317SjeanPerier mlir::func::FuncOp procDef = Fortran::lower::getOrDeclareFunction( 37188684317SjeanPerier Fortran::evaluate::ProcedureDesignator{*procSym}, converter); 37288684317SjeanPerier mlir::SymbolRefAttr nameAttr = 37388684317SjeanPerier builder.getSymbolRefAttr(procDef.getSymName()); 37488684317SjeanPerier insert(builder.createConvert( 37588684317SjeanPerier loc, refTy, 37688684317SjeanPerier builder.create<fir::AddrOfOp>(loc, procDef.getFunctionType(), 37788684317SjeanPerier nameAttr))); 3786f7a3b07SV Donaldson } 3796f7a3b07SV Donaldson } else { 3806f7a3b07SV Donaldson insert(builder.createNullConstant(loc, refTy)); 3816f7a3b07SV Donaldson } 3826f7a3b07SV Donaldson // defined IO variant, one of (read/write, formatted/unformatted) 3836f7a3b07SV Donaldson // [common::DefinedIo definedIo] 3846f7a3b07SV Donaldson insert(builder.createIntegerConstant( 3856f7a3b07SV Donaldson loc, intTy, static_cast<int>(iface.second.definedIo))); 3866f7a3b07SV Donaldson // polymorphic flag is set if first defined IO dummy arg is CLASS(T) 3876f7a3b07SV Donaldson // [bool isDtvArgPolymorphic] 3886f7a3b07SV Donaldson insert(builder.createIntegerConstant(loc, boolTy, 3896f7a3b07SV Donaldson iface.second.isDtvArgPolymorphic)); 3906f7a3b07SV Donaldson } 3916f7a3b07SV Donaldson if (tableIsLocal) 3926f7a3b07SV Donaldson builder.create<fir::StoreOp>(loc, list, listAddr); 3936f7a3b07SV Donaldson else 3946f7a3b07SV Donaldson builder.create<fir::HasValueOp>(loc, list); 3956f7a3b07SV Donaldson }; 3966f7a3b07SV Donaldson if (!definedIoProcMap.empty()) { 3976f7a3b07SV Donaldson if (tableIsLocal) 3986f7a3b07SV Donaldson listFunc(builder); 3996f7a3b07SV Donaldson else 4006f7a3b07SV Donaldson builder.createGlobalConstant(loc, listTy, listMangleName, listFunc, 4016f7a3b07SV Donaldson linkOnce); 4026f7a3b07SV Donaldson } 4036f7a3b07SV Donaldson 4046f7a3b07SV Donaldson // Define the NonTbpDefinedIoTable. 4056f7a3b07SV Donaldson mlir::Value tableAddr = tableIsLocal 4066f7a3b07SV Donaldson ? builder.create<fir::AllocaOp>(loc, tableTy) 4076f7a3b07SV Donaldson : mlir::Value{}; 4086f7a3b07SV Donaldson auto tableFunc = [&](fir::FirOpBuilder &builder) { 4096f7a3b07SV Donaldson mlir::Value table = builder.create<fir::UndefOp>(loc, tableTy); 4106f7a3b07SV Donaldson // list item count [std::size_t items] 4116f7a3b07SV Donaldson table = builder.create<fir::InsertValueOp>( 4126f7a3b07SV Donaldson loc, tableTy, table, 4136f7a3b07SV Donaldson builder.createIntegerConstant(loc, sizeTy, definedIoProcMap.size()), 4146f7a3b07SV Donaldson builder.getArrayAttr(builder.getIntegerAttr(idxTy, 0))); 4156f7a3b07SV Donaldson // item list [const NonTbpDefinedIo *item] 4166f7a3b07SV Donaldson if (definedIoProcMap.empty()) 4176f7a3b07SV Donaldson listAddr = builder.createNullConstant(loc, builder.getRefType(listTy)); 4186f7a3b07SV Donaldson else if (fir::GlobalOp list = builder.getNamedGlobal(listMangleName)) 4196f7a3b07SV Donaldson listAddr = builder.create<fir::AddrOfOp>(loc, list.resultType(), 4206f7a3b07SV Donaldson list.getSymbol()); 4216f7a3b07SV Donaldson assert(listAddr && "missing namelist object list"); 4226f7a3b07SV Donaldson table = builder.create<fir::InsertValueOp>( 4236f7a3b07SV Donaldson loc, tableTy, table, listAddr, 4246f7a3b07SV Donaldson builder.getArrayAttr(builder.getIntegerAttr(idxTy, 1))); 4256f7a3b07SV Donaldson // [bool ignoreNonTbpEntries] conservatively set to true 4266f7a3b07SV Donaldson table = builder.create<fir::InsertValueOp>( 4276f7a3b07SV Donaldson loc, tableTy, table, builder.createIntegerConstant(loc, boolTy, true), 4286f7a3b07SV Donaldson builder.getArrayAttr(builder.getIntegerAttr(idxTy, 2))); 4296f7a3b07SV Donaldson if (tableIsLocal) 4306f7a3b07SV Donaldson builder.create<fir::StoreOp>(loc, table, tableAddr); 4316f7a3b07SV Donaldson else 4326f7a3b07SV Donaldson builder.create<fir::HasValueOp>(loc, table); 4336f7a3b07SV Donaldson }; 4346f7a3b07SV Donaldson if (tableIsLocal) { 4356f7a3b07SV Donaldson tableFunc(builder); 4366f7a3b07SV Donaldson } else { 4376f7a3b07SV Donaldson fir::GlobalOp table = builder.createGlobal( 4386f7a3b07SV Donaldson loc, tableTy, tableMangleName, 4396f7a3b07SV Donaldson /*isConst=*/true, /*isTarget=*/false, tableFunc, linkOnce); 4406f7a3b07SV Donaldson tableAddr = builder.create<fir::AddrOfOp>( 4416f7a3b07SV Donaldson loc, fir::ReferenceType::get(tableTy), table.getSymbol()); 4426f7a3b07SV Donaldson } 4436f7a3b07SV Donaldson assert(tableAddr && "missing NonTbpDefinedIo table result"); 4446f7a3b07SV Donaldson return builder.createConvert(loc, refTy, tableAddr); 4456f7a3b07SV Donaldson } 4466f7a3b07SV Donaldson 4476f7a3b07SV Donaldson static mlir::Value 4486f7a3b07SV Donaldson getNonTbpDefinedIoTableAddr(Fortran::lower::AbstractConverter &converter) { 4496f7a3b07SV Donaldson DefinedIoProcMap definedIoProcMap = getDefinedIoProcMap(converter); 4506f7a3b07SV Donaldson return getNonTbpDefinedIoTableAddr(converter, definedIoProcMap); 4516f7a3b07SV Donaldson } 4526f7a3b07SV Donaldson 4536f7a3b07SV Donaldson /// Retrieve or generate a runtime description of NAMELIST group \p symbol. 4548c22cb84SValentin Clement /// The form of the description is defined in runtime header file namelist.h. 4558c22cb84SValentin Clement /// Static descriptors are generated for global objects; local descriptors for 4566f7a3b07SV Donaldson /// local objects. If all descriptors and defined IO procedures are static, 4576f7a3b07SV Donaldson /// the NamelistGroup is static. 4588c22cb84SValentin Clement static mlir::Value 4598c22cb84SValentin Clement getNamelistGroup(Fortran::lower::AbstractConverter &converter, 4608c22cb84SValentin Clement const Fortran::semantics::Symbol &symbol, 4618c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 4628c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 4638c22cb84SValentin Clement mlir::Location loc = converter.getCurrentLocation(); 4648c22cb84SValentin Clement std::string groupMangleName = converter.mangleName(symbol); 4658c22cb84SValentin Clement if (auto group = builder.getNamedGlobal(groupMangleName)) 4668c22cb84SValentin Clement return builder.create<fir::AddrOfOp>(loc, group.resultType(), 4678c22cb84SValentin Clement group.getSymbol()); 4688c22cb84SValentin Clement 4698c22cb84SValentin Clement const auto &details = 4708c22cb84SValentin Clement symbol.GetUltimate().get<Fortran::semantics::NamelistDetails>(); 4718c22cb84SValentin Clement mlir::MLIRContext *context = builder.getContext(); 4728c22cb84SValentin Clement mlir::StringAttr linkOnce = builder.createLinkOnceLinkage(); 4736f7a3b07SV Donaldson mlir::Type idxTy = builder.getIndexType(); 4746f7a3b07SV Donaldson mlir::Type sizeTy = 4756f7a3b07SV Donaldson fir::runtime::getModel<std::size_t>()(builder.getContext()); 4766f7a3b07SV Donaldson mlir::Type charRefTy = fir::ReferenceType::get(builder.getIntegerType(8)); 4776f7a3b07SV Donaldson mlir::Type descRefTy = 4788c22cb84SValentin Clement fir::ReferenceType::get(fir::BoxType::get(mlir::NoneType::get(context))); 4796f7a3b07SV Donaldson mlir::Type listTy = fir::SequenceType::get( 4808c22cb84SValentin Clement details.objects().size(), 4818c22cb84SValentin Clement mlir::TupleType::get(context, {charRefTy, descRefTy})); 4826f7a3b07SV Donaldson mlir::Type groupTy = mlir::TupleType::get( 4836f7a3b07SV Donaldson context, {charRefTy, sizeTy, fir::ReferenceType::get(listTy), 4846f7a3b07SV Donaldson fir::ReferenceType::get(mlir::NoneType::get(context))}); 4858c22cb84SValentin Clement auto stringAddress = [&](const Fortran::semantics::Symbol &symbol) { 4868c22cb84SValentin Clement return fir::factory::createStringLiteral(builder, loc, 4878c22cb84SValentin Clement symbol.name().ToString() + '\0'); 4888c22cb84SValentin Clement }; 4898c22cb84SValentin Clement 490518e6f12SV Donaldson // Define variable names, and static descriptors for global variables. 4916f7a3b07SV Donaldson DefinedIoProcMap definedIoProcMap = getDefinedIoProcMap(converter); 4926f7a3b07SV Donaldson bool groupIsLocal = hasLocalDefinedIoProc(definedIoProcMap); 4938c22cb84SValentin Clement stringAddress(symbol); 4948c22cb84SValentin Clement for (const Fortran::semantics::Symbol &s : details.objects()) { 4958c22cb84SValentin Clement stringAddress(s); 4968c22cb84SValentin Clement if (!Fortran::lower::symbolIsGlobal(s)) { 4978c22cb84SValentin Clement groupIsLocal = true; 4988c22cb84SValentin Clement continue; 4998c22cb84SValentin Clement } 500518e6f12SV Donaldson // A global pointer or allocatable variable has a descriptor for typical 501518e6f12SV Donaldson // accesses. Variables in multiple namelist groups may already have one. 502518e6f12SV Donaldson // Create descriptors for other cases. 503031b4e5eSPeter Klausler if (!IsAllocatableOrObjectPointer(&s)) { 504518e6f12SV Donaldson std::string mangleName = 505518e6f12SV Donaldson Fortran::lower::mangle::globalNamelistDescriptorName(s); 5068c22cb84SValentin Clement if (builder.getNamedGlobal(mangleName)) 5078c22cb84SValentin Clement continue; 5088c22cb84SValentin Clement const auto expr = Fortran::evaluate::AsGenericExpr(s); 5098c22cb84SValentin Clement fir::BoxType boxTy = 5108c22cb84SValentin Clement fir::BoxType::get(fir::PointerType::get(converter.genType(s))); 5118c22cb84SValentin Clement auto descFunc = [&](fir::FirOpBuilder &b) { 512518e6f12SV Donaldson auto box = Fortran::lower::genInitialDataTarget( 513518e6f12SV Donaldson converter, loc, boxTy, *expr, /*couldBeInEquivalence=*/true); 5148c22cb84SValentin Clement b.create<fir::HasValueOp>(loc, box); 5158c22cb84SValentin Clement }; 5168c22cb84SValentin Clement builder.createGlobalConstant(loc, boxTy, mangleName, descFunc, linkOnce); 5178c22cb84SValentin Clement } 5189aeb7f03SValentin Clement } 5198c22cb84SValentin Clement 5208c22cb84SValentin Clement // Define the list of Items. 5218c22cb84SValentin Clement mlir::Value listAddr = 5228c22cb84SValentin Clement groupIsLocal ? builder.create<fir::AllocaOp>(loc, listTy) : mlir::Value{}; 5238c22cb84SValentin Clement std::string listMangleName = groupMangleName + ".list"; 5248c22cb84SValentin Clement auto listFunc = [&](fir::FirOpBuilder &builder) { 5258c22cb84SValentin Clement mlir::Value list = builder.create<fir::UndefOp>(loc, listTy); 5268c22cb84SValentin Clement mlir::IntegerAttr zero = builder.getIntegerAttr(idxTy, 0); 5278c22cb84SValentin Clement mlir::IntegerAttr one = builder.getIntegerAttr(idxTy, 1); 5288c22cb84SValentin Clement llvm::SmallVector<mlir::Attribute, 2> idx = {mlir::Attribute{}, 5298c22cb84SValentin Clement mlir::Attribute{}}; 5306f7a3b07SV Donaldson int n = 0; 5318c22cb84SValentin Clement for (const Fortran::semantics::Symbol &s : details.objects()) { 5326f7a3b07SV Donaldson idx[0] = builder.getIntegerAttr(idxTy, n++); 5338c22cb84SValentin Clement idx[1] = zero; 5348c22cb84SValentin Clement mlir::Value nameAddr = 5358c22cb84SValentin Clement builder.createConvert(loc, charRefTy, fir::getBase(stringAddress(s))); 5368c22cb84SValentin Clement list = builder.create<fir::InsertValueOp>(loc, listTy, list, nameAddr, 5378c22cb84SValentin Clement builder.getArrayAttr(idx)); 5388c22cb84SValentin Clement idx[1] = one; 5398c22cb84SValentin Clement mlir::Value descAddr; 540518e6f12SV Donaldson if (auto desc = builder.getNamedGlobal( 541518e6f12SV Donaldson Fortran::lower::mangle::globalNamelistDescriptorName(s))) { 5428c22cb84SValentin Clement descAddr = builder.create<fir::AddrOfOp>(loc, desc.resultType(), 5438c22cb84SValentin Clement desc.getSymbol()); 544c0185c8dSValentin Clement } else if (Fortran::semantics::FindCommonBlockContaining(s) && 545c0185c8dSValentin Clement IsAllocatableOrPointer(s)) { 546c0185c8dSValentin Clement mlir::Type symType = converter.genType(s); 547c0185c8dSValentin Clement const Fortran::semantics::Symbol *commonBlockSym = 548c0185c8dSValentin Clement Fortran::semantics::FindCommonBlockContaining(s); 549c0185c8dSValentin Clement std::string commonBlockName = converter.mangleName(*commonBlockSym); 550c0185c8dSValentin Clement fir::GlobalOp commonGlobal = builder.getNamedGlobal(commonBlockName); 551c0185c8dSValentin Clement mlir::Value commonBlockAddr = builder.create<fir::AddrOfOp>( 552c0185c8dSValentin Clement loc, commonGlobal.resultType(), commonGlobal.getSymbol()); 553c0185c8dSValentin Clement mlir::IntegerType i8Ty = builder.getIntegerType(8); 554c0185c8dSValentin Clement mlir::Type i8Ptr = builder.getRefType(i8Ty); 555c0185c8dSValentin Clement mlir::Type seqTy = builder.getRefType(builder.getVarLenSeqTy(i8Ty)); 556c0185c8dSValentin Clement mlir::Value base = builder.createConvert(loc, seqTy, commonBlockAddr); 557c0185c8dSValentin Clement std::size_t byteOffset = s.GetUltimate().offset(); 558c0185c8dSValentin Clement mlir::Value offs = builder.createIntegerConstant( 559c0185c8dSValentin Clement loc, builder.getIndexType(), byteOffset); 560c0185c8dSValentin Clement mlir::Value varAddr = builder.create<fir::CoordinateOp>( 561c0185c8dSValentin Clement loc, i8Ptr, base, mlir::ValueRange{offs}); 562c0185c8dSValentin Clement descAddr = 563c0185c8dSValentin Clement builder.createConvert(loc, builder.getRefType(symType), varAddr); 5648c22cb84SValentin Clement } else { 5658c22cb84SValentin Clement const auto expr = Fortran::evaluate::AsGenericExpr(s); 5668c22cb84SValentin Clement fir::ExtendedValue exv = converter.genExprAddr(*expr, stmtCtx); 5678c22cb84SValentin Clement mlir::Type type = fir::getBase(exv).getType(); 5688c22cb84SValentin Clement if (mlir::Type baseTy = fir::dyn_cast_ptrOrBoxEleTy(type)) 5698c22cb84SValentin Clement type = baseTy; 5708c22cb84SValentin Clement fir::BoxType boxType = fir::BoxType::get(fir::PointerType::get(type)); 5718c22cb84SValentin Clement descAddr = builder.createTemporary(loc, boxType); 5728c22cb84SValentin Clement fir::MutableBoxValue box = fir::MutableBoxValue(descAddr, {}, {}); 5738c22cb84SValentin Clement fir::factory::associateMutableBox(builder, loc, box, exv, 5749a417395SKazu Hirata /*lbounds=*/std::nullopt); 5758c22cb84SValentin Clement } 5768c22cb84SValentin Clement descAddr = builder.createConvert(loc, descRefTy, descAddr); 5778c22cb84SValentin Clement list = builder.create<fir::InsertValueOp>(loc, listTy, list, descAddr, 5788c22cb84SValentin Clement builder.getArrayAttr(idx)); 5798c22cb84SValentin Clement } 5808c22cb84SValentin Clement if (groupIsLocal) 5818c22cb84SValentin Clement builder.create<fir::StoreOp>(loc, list, listAddr); 5828c22cb84SValentin Clement else 5838c22cb84SValentin Clement builder.create<fir::HasValueOp>(loc, list); 5848c22cb84SValentin Clement }; 5858c22cb84SValentin Clement if (groupIsLocal) 5868c22cb84SValentin Clement listFunc(builder); 5878c22cb84SValentin Clement else 5888c22cb84SValentin Clement builder.createGlobalConstant(loc, listTy, listMangleName, listFunc, 5898c22cb84SValentin Clement linkOnce); 5908c22cb84SValentin Clement 5918c22cb84SValentin Clement // Define the group. 5928c22cb84SValentin Clement mlir::Value groupAddr = groupIsLocal 5938c22cb84SValentin Clement ? builder.create<fir::AllocaOp>(loc, groupTy) 5948c22cb84SValentin Clement : mlir::Value{}; 5958c22cb84SValentin Clement auto groupFunc = [&](fir::FirOpBuilder &builder) { 5968c22cb84SValentin Clement mlir::Value group = builder.create<fir::UndefOp>(loc, groupTy); 5976f7a3b07SV Donaldson // group name [const char *groupName] 5986f7a3b07SV Donaldson group = builder.create<fir::InsertValueOp>( 5996f7a3b07SV Donaldson loc, groupTy, group, 6006f7a3b07SV Donaldson builder.createConvert(loc, charRefTy, 6016f7a3b07SV Donaldson fir::getBase(stringAddress(symbol))), 6026f7a3b07SV Donaldson builder.getArrayAttr(builder.getIntegerAttr(idxTy, 0))); 6036f7a3b07SV Donaldson // list item count [std::size_t items] 6046f7a3b07SV Donaldson group = builder.create<fir::InsertValueOp>( 6056f7a3b07SV Donaldson loc, groupTy, group, 6066f7a3b07SV Donaldson builder.createIntegerConstant(loc, sizeTy, details.objects().size()), 6076f7a3b07SV Donaldson builder.getArrayAttr(builder.getIntegerAttr(idxTy, 1))); 6086f7a3b07SV Donaldson // item list [const Item *item] 6098c22cb84SValentin Clement if (fir::GlobalOp list = builder.getNamedGlobal(listMangleName)) 6108c22cb84SValentin Clement listAddr = builder.create<fir::AddrOfOp>(loc, list.resultType(), 6118c22cb84SValentin Clement list.getSymbol()); 6128c22cb84SValentin Clement assert(listAddr && "missing namelist object list"); 6136f7a3b07SV Donaldson group = builder.create<fir::InsertValueOp>( 6146f7a3b07SV Donaldson loc, groupTy, group, listAddr, 6156f7a3b07SV Donaldson builder.getArrayAttr(builder.getIntegerAttr(idxTy, 2))); 6166f7a3b07SV Donaldson // non-type-bound defined IO procedures 6176f7a3b07SV Donaldson // [const NonTbpDefinedIoTable *nonTbpDefinedIo] 6186f7a3b07SV Donaldson group = builder.create<fir::InsertValueOp>( 6196f7a3b07SV Donaldson loc, groupTy, group, 6206f7a3b07SV Donaldson getNonTbpDefinedIoTableAddr(converter, definedIoProcMap), 6216f7a3b07SV Donaldson builder.getArrayAttr(builder.getIntegerAttr(idxTy, 3))); 6228c22cb84SValentin Clement if (groupIsLocal) 6238c22cb84SValentin Clement builder.create<fir::StoreOp>(loc, group, groupAddr); 6248c22cb84SValentin Clement else 6258c22cb84SValentin Clement builder.create<fir::HasValueOp>(loc, group); 6268c22cb84SValentin Clement }; 6278c22cb84SValentin Clement if (groupIsLocal) { 6288c22cb84SValentin Clement groupFunc(builder); 6298c22cb84SValentin Clement } else { 630ac76fa48SSlava Zakharin fir::GlobalOp group = builder.createGlobal( 631ac76fa48SSlava Zakharin loc, groupTy, groupMangleName, 632ac76fa48SSlava Zakharin /*isConst=*/true, /*isTarget=*/false, groupFunc, linkOnce); 6338c22cb84SValentin Clement groupAddr = builder.create<fir::AddrOfOp>(loc, group.resultType(), 6348c22cb84SValentin Clement group.getSymbol()); 6358c22cb84SValentin Clement } 6368c22cb84SValentin Clement assert(groupAddr && "missing namelist group result"); 6378c22cb84SValentin Clement return groupAddr; 6388c22cb84SValentin Clement } 6398c22cb84SValentin Clement 6408c22cb84SValentin Clement /// Generate a namelist IO call. 6418c22cb84SValentin Clement static void genNamelistIO(Fortran::lower::AbstractConverter &converter, 64258ceae95SRiver Riddle mlir::Value cookie, mlir::func::FuncOp funcOp, 6438c22cb84SValentin Clement Fortran::semantics::Symbol &symbol, bool checkResult, 6448c22cb84SValentin Clement mlir::Value &ok, 6458c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 6468c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 6478c22cb84SValentin Clement mlir::Location loc = converter.getCurrentLocation(); 6488c22cb84SValentin Clement makeNextConditionalOn(builder, loc, checkResult, ok); 6494a3460a7SRiver Riddle mlir::Type argType = funcOp.getFunctionType().getInput(1); 6501220edc6Svdonaldson mlir::Value groupAddr = 6511220edc6Svdonaldson getNamelistGroup(converter, symbol.GetUltimate(), stmtCtx); 6528c22cb84SValentin Clement groupAddr = builder.createConvert(loc, argType, groupAddr); 6538c22cb84SValentin Clement llvm::SmallVector<mlir::Value> args = {cookie, groupAddr}; 6548c22cb84SValentin Clement ok = builder.create<fir::CallOp>(loc, funcOp, args).getResult(0); 6558c22cb84SValentin Clement } 6568c22cb84SValentin Clement 6578c22cb84SValentin Clement /// Get the output function to call for a value of the given type. 65858ceae95SRiver Riddle static mlir::func::FuncOp getOutputFunc(mlir::Location loc, 65958ceae95SRiver Riddle fir::FirOpBuilder &builder, 66058ceae95SRiver Riddle mlir::Type type, bool isFormatted) { 661fac349a1SChristian Sigg if (mlir::isa<fir::RecordType>(fir::unwrapPassByRefType(type))) 6626f7a3b07SV Donaldson return getIORuntimeFunc<mkIOKey(OutputDerivedType)>(loc, builder); 6638c22cb84SValentin Clement if (!isFormatted) 6648c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder); 665fac349a1SChristian Sigg if (auto ty = mlir::dyn_cast<mlir::IntegerType>(type)) { 666fc97d2e6SPeter Klausler if (!ty.isUnsigned()) { 6678c22cb84SValentin Clement switch (ty.getWidth()) { 6688c22cb84SValentin Clement case 1: 6698c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder); 6708c22cb84SValentin Clement case 8: 6718c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputInteger8)>(loc, builder); 6728c22cb84SValentin Clement case 16: 6738c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputInteger16)>(loc, builder); 6748c22cb84SValentin Clement case 32: 6758c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputInteger32)>(loc, builder); 6768c22cb84SValentin Clement case 64: 6778c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder); 6788c22cb84SValentin Clement case 128: 6798c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder); 6808c22cb84SValentin Clement } 6818c22cb84SValentin Clement llvm_unreachable("unknown OutputInteger kind"); 6828c22cb84SValentin Clement } 683fc97d2e6SPeter Klausler } 684fac349a1SChristian Sigg if (auto ty = mlir::dyn_cast<mlir::FloatType>(type)) { 6858c22cb84SValentin Clement if (auto width = ty.getWidth(); width == 32) 6868c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputReal32)>(loc, builder); 6878c22cb84SValentin Clement else if (width == 64) 6888c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputReal64)>(loc, builder); 6898c22cb84SValentin Clement } 6909aeb7f03SValentin Clement auto kindMap = fir::getKindMapping(builder.getModule()); 691c4204c0bSjeanPerier if (auto ty = mlir::dyn_cast<mlir::ComplexType>(type)) { 6929aeb7f03SValentin Clement // COMPLEX(KIND=k) corresponds to a pair of REAL(KIND=k). 693c4204c0bSjeanPerier auto width = mlir::cast<mlir::FloatType>(ty.getElementType()).getWidth(); 6949aeb7f03SValentin Clement if (width == 32) 6958c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputComplex32)>(loc, builder); 6969aeb7f03SValentin Clement else if (width == 64) 6978c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputComplex64)>(loc, builder); 6988c22cb84SValentin Clement } 699fac349a1SChristian Sigg if (mlir::isa<fir::LogicalType>(type)) 7008c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder); 7019aeb7f03SValentin Clement if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) { 7029aeb7f03SValentin Clement // TODO: What would it mean if the default CHARACTER KIND is set to a wide 7039aeb7f03SValentin Clement // character encoding scheme? How do we handle UTF-8? Is it a distinct KIND 7049aeb7f03SValentin Clement // value? For now, assume that if the default CHARACTER KIND is 8 bit, 7059aeb7f03SValentin Clement // then it is an ASCII string and UTF-8 is unsupported. 7069aeb7f03SValentin Clement auto asciiKind = kindMap.defaultCharacterKind(); 7079aeb7f03SValentin Clement if (kindMap.getCharacterBitsize(asciiKind) == 8 && 7089aeb7f03SValentin Clement fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind) 7098c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputAscii)>(loc, builder); 7109aeb7f03SValentin Clement } 7118c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder); 7128c22cb84SValentin Clement } 7138c22cb84SValentin Clement 7148c22cb84SValentin Clement /// Generate a sequence of output data transfer calls. 7151bffc753SEric Schweitz static void genOutputItemList( 7161bffc753SEric Schweitz Fortran::lower::AbstractConverter &converter, mlir::Value cookie, 7171bffc753SEric Schweitz const std::list<Fortran::parser::OutputItem> &items, bool isFormatted, 7181bffc753SEric Schweitz bool checkResult, mlir::Value &ok, bool inLoop) { 7198c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 7208c22cb84SValentin Clement for (const Fortran::parser::OutputItem &item : items) { 7218c22cb84SValentin Clement if (const auto &impliedDo = std::get_if<1>(&item.u)) { 7228c22cb84SValentin Clement genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult, 7231bffc753SEric Schweitz ok, inLoop); 7248c22cb84SValentin Clement continue; 7258c22cb84SValentin Clement } 7268c22cb84SValentin Clement auto &pExpr = std::get<Fortran::parser::Expr>(item.u); 7278c22cb84SValentin Clement mlir::Location loc = converter.genLocation(pExpr.source); 7288c22cb84SValentin Clement makeNextConditionalOn(builder, loc, checkResult, ok, inLoop); 7291bffc753SEric Schweitz Fortran::lower::StatementContext stmtCtx; 7308c22cb84SValentin Clement 7318c22cb84SValentin Clement const auto *expr = Fortran::semantics::GetExpr(pExpr); 7328c22cb84SValentin Clement if (!expr) 7338c22cb84SValentin Clement fir::emitFatalError(loc, "internal error: could not get evaluate::Expr"); 7348c22cb84SValentin Clement mlir::Type itemTy = converter.genType(*expr); 7351c7889caSValentin Clement mlir::func::FuncOp outputFunc = 7361c7889caSValentin Clement getOutputFunc(loc, builder, itemTy, isFormatted); 7374a3460a7SRiver Riddle mlir::Type argType = outputFunc.getFunctionType().getInput(1); 738fac349a1SChristian Sigg assert((isFormatted || mlir::isa<fir::BoxType>(argType)) && 7398c22cb84SValentin Clement "expect descriptor for unformatted IO runtime"); 7408c22cb84SValentin Clement llvm::SmallVector<mlir::Value> outputFuncArgs = {cookie}; 7418c22cb84SValentin Clement fir::factory::CharacterExprHelper helper{builder, loc}; 742fac349a1SChristian Sigg if (mlir::isa<fir::BoxType>(argType)) { 7431bffc753SEric Schweitz mlir::Value box = fir::getBase(converter.genExprBox(loc, *expr, stmtCtx)); 7448c22cb84SValentin Clement outputFuncArgs.push_back(builder.createConvert(loc, argType, box)); 745fac349a1SChristian Sigg if (mlir::isa<fir::RecordType>(fir::unwrapPassByRefType(itemTy))) 7466f7a3b07SV Donaldson outputFuncArgs.push_back(getNonTbpDefinedIoTableAddr(converter)); 7478c22cb84SValentin Clement } else if (helper.isCharacterScalar(itemTy)) { 7481bffc753SEric Schweitz fir::ExtendedValue exv = converter.genExprAddr(loc, expr, stmtCtx); 7498c22cb84SValentin Clement // scalar allocatable/pointer may also get here, not clear if 7508c22cb84SValentin Clement // genExprAddr will lower them as CharBoxValue or BoxValue. 7518c22cb84SValentin Clement if (!exv.getCharBox()) 7528c22cb84SValentin Clement llvm::report_fatal_error( 7538c22cb84SValentin Clement "internal error: scalar character not in CharBox"); 7548c22cb84SValentin Clement outputFuncArgs.push_back(builder.createConvert( 7554a3460a7SRiver Riddle loc, outputFunc.getFunctionType().getInput(1), fir::getBase(exv))); 7568c22cb84SValentin Clement outputFuncArgs.push_back(builder.createConvert( 7574a3460a7SRiver Riddle loc, outputFunc.getFunctionType().getInput(2), fir::getLen(exv))); 7588c22cb84SValentin Clement } else { 7591bffc753SEric Schweitz fir::ExtendedValue itemBox = converter.genExprValue(loc, expr, stmtCtx); 7608c22cb84SValentin Clement mlir::Value itemValue = fir::getBase(itemBox); 7618c22cb84SValentin Clement if (fir::isa_complex(itemTy)) { 7628c22cb84SValentin Clement auto parts = 7638c22cb84SValentin Clement fir::factory::Complex{builder, loc}.extractParts(itemValue); 7648c22cb84SValentin Clement outputFuncArgs.push_back(parts.first); 7658c22cb84SValentin Clement outputFuncArgs.push_back(parts.second); 7668c22cb84SValentin Clement } else { 7678c22cb84SValentin Clement itemValue = builder.createConvert(loc, argType, itemValue); 7688c22cb84SValentin Clement outputFuncArgs.push_back(itemValue); 7698c22cb84SValentin Clement } 7708c22cb84SValentin Clement } 7718c22cb84SValentin Clement ok = builder.create<fir::CallOp>(loc, outputFunc, outputFuncArgs) 7728c22cb84SValentin Clement .getResult(0); 7738c22cb84SValentin Clement } 7748c22cb84SValentin Clement } 7758c22cb84SValentin Clement 7768c22cb84SValentin Clement /// Get the input function to call for a value of the given type. 77758ceae95SRiver Riddle static mlir::func::FuncOp getInputFunc(mlir::Location loc, 77858ceae95SRiver Riddle fir::FirOpBuilder &builder, 7798c22cb84SValentin Clement mlir::Type type, bool isFormatted) { 780fac349a1SChristian Sigg if (mlir::isa<fir::RecordType>(fir::unwrapPassByRefType(type))) 7816f7a3b07SV Donaldson return getIORuntimeFunc<mkIOKey(InputDerivedType)>(loc, builder); 7828c22cb84SValentin Clement if (!isFormatted) 7838c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder); 784fc97d2e6SPeter Klausler if (auto ty = mlir::dyn_cast<mlir::IntegerType>(type)) { 785fc97d2e6SPeter Klausler if (type.isUnsignedInteger()) 786fc97d2e6SPeter Klausler return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder); 7878c22cb84SValentin Clement return ty.getWidth() == 1 7888c22cb84SValentin Clement ? getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder) 7898c22cb84SValentin Clement : getIORuntimeFunc<mkIOKey(InputInteger)>(loc, builder); 790fc97d2e6SPeter Klausler } 791fac349a1SChristian Sigg if (auto ty = mlir::dyn_cast<mlir::FloatType>(type)) { 792575eb213SValentin Clement if (auto width = ty.getWidth(); width == 32) 7938c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(InputReal32)>(loc, builder); 794575eb213SValentin Clement else if (width == 64) 7958c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(InputReal64)>(loc, builder); 7968c22cb84SValentin Clement } 7979aeb7f03SValentin Clement auto kindMap = fir::getKindMapping(builder.getModule()); 798c4204c0bSjeanPerier if (auto ty = mlir::dyn_cast<mlir::ComplexType>(type)) { 799c4204c0bSjeanPerier auto width = mlir::cast<mlir::FloatType>(ty.getElementType()).getWidth(); 800575eb213SValentin Clement if (width == 32) 8018c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(InputComplex32)>(loc, builder); 802575eb213SValentin Clement else if (width == 64) 8038c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(InputComplex64)>(loc, builder); 8048c22cb84SValentin Clement } 805fac349a1SChristian Sigg if (mlir::isa<fir::LogicalType>(type)) 8068c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder); 8079aeb7f03SValentin Clement if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) { 8089aeb7f03SValentin Clement auto asciiKind = kindMap.defaultCharacterKind(); 8099aeb7f03SValentin Clement if (kindMap.getCharacterBitsize(asciiKind) == 8 && 8109aeb7f03SValentin Clement fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind) 8118c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(InputAscii)>(loc, builder); 8129aeb7f03SValentin Clement } 8138c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder); 8148c22cb84SValentin Clement } 8158c22cb84SValentin Clement 8169aeb7f03SValentin Clement /// Interpret the lowest byte of a LOGICAL and store that value into the full 8179aeb7f03SValentin Clement /// storage of the LOGICAL. The load, convert, and store effectively (sign or 8189aeb7f03SValentin Clement /// zero) extends the lowest byte into the full LOGICAL value storage, as the 8199aeb7f03SValentin Clement /// runtime is unaware of the LOGICAL value's actual bit width (it was passed 8209aeb7f03SValentin Clement /// as a `bool&` to the runtime in order to be set). 8219aeb7f03SValentin Clement static void boolRefToLogical(mlir::Location loc, fir::FirOpBuilder &builder, 8229aeb7f03SValentin Clement mlir::Value addr) { 8239aeb7f03SValentin Clement auto boolType = builder.getRefType(builder.getI1Type()); 8249aeb7f03SValentin Clement auto boolAddr = builder.createConvert(loc, boolType, addr); 8259aeb7f03SValentin Clement auto boolValue = builder.create<fir::LoadOp>(loc, boolAddr); 8269aeb7f03SValentin Clement auto logicalType = fir::unwrapPassByRefType(addr.getType()); 8279aeb7f03SValentin Clement // The convert avoid making any assumptions about how LOGICALs are actually 8289aeb7f03SValentin Clement // represented (it might end-up being either a signed or zero extension). 8299aeb7f03SValentin Clement auto logicalValue = builder.createConvert(loc, logicalType, boolValue); 8309aeb7f03SValentin Clement builder.create<fir::StoreOp>(loc, logicalValue, addr); 8319aeb7f03SValentin Clement } 8329aeb7f03SValentin Clement 8336f7a3b07SV Donaldson static mlir::Value 8346f7a3b07SV Donaldson createIoRuntimeCallForItem(Fortran::lower::AbstractConverter &converter, 8356f7a3b07SV Donaldson mlir::Location loc, mlir::func::FuncOp inputFunc, 8366f7a3b07SV Donaldson mlir::Value cookie, const fir::ExtendedValue &item) { 8376f7a3b07SV Donaldson fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 8384a3460a7SRiver Riddle mlir::Type argType = inputFunc.getFunctionType().getInput(1); 8398c22cb84SValentin Clement llvm::SmallVector<mlir::Value> inputFuncArgs = {cookie}; 840fac349a1SChristian Sigg if (mlir::isa<fir::BaseBoxType>(argType)) { 8418c22cb84SValentin Clement mlir::Value box = fir::getBase(item); 842fac349a1SChristian Sigg auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(box.getType()); 8436f7a3b07SV Donaldson assert(boxTy && "must be previously emboxed"); 8448c22cb84SValentin Clement inputFuncArgs.push_back(builder.createConvert(loc, argType, box)); 845fac349a1SChristian Sigg if (mlir::isa<fir::RecordType>(fir::unwrapPassByRefType(boxTy))) 8466f7a3b07SV Donaldson inputFuncArgs.push_back(getNonTbpDefinedIoTableAddr(converter)); 8478c22cb84SValentin Clement } else { 8488c22cb84SValentin Clement mlir::Value itemAddr = fir::getBase(item); 8498c22cb84SValentin Clement mlir::Type itemTy = fir::unwrapPassByRefType(itemAddr.getType()); 8508c22cb84SValentin Clement inputFuncArgs.push_back(builder.createConvert(loc, argType, itemAddr)); 8518c22cb84SValentin Clement fir::factory::CharacterExprHelper charHelper{builder, loc}; 8528c22cb84SValentin Clement if (charHelper.isCharacterScalar(itemTy)) { 8538c22cb84SValentin Clement mlir::Value len = fir::getLen(item); 8544a3460a7SRiver Riddle inputFuncArgs.push_back(builder.createConvert( 8554a3460a7SRiver Riddle loc, inputFunc.getFunctionType().getInput(2), len)); 856fac349a1SChristian Sigg } else if (mlir::isa<mlir::IntegerType>(itemTy)) { 8578c22cb84SValentin Clement inputFuncArgs.push_back(builder.create<mlir::arith::ConstantOp>( 8588c22cb84SValentin Clement loc, builder.getI32IntegerAttr( 859fac349a1SChristian Sigg mlir::cast<mlir::IntegerType>(itemTy).getWidth() / 8))); 8608c22cb84SValentin Clement } 8618c22cb84SValentin Clement } 8629aeb7f03SValentin Clement auto call = builder.create<fir::CallOp>(loc, inputFunc, inputFuncArgs); 8639aeb7f03SValentin Clement auto itemAddr = fir::getBase(item); 8649aeb7f03SValentin Clement auto itemTy = fir::unwrapRefType(itemAddr.getType()); 865fac349a1SChristian Sigg if (mlir::isa<fir::LogicalType>(itemTy)) 8669aeb7f03SValentin Clement boolRefToLogical(loc, builder, itemAddr); 8679aeb7f03SValentin Clement return call.getResult(0); 8688c22cb84SValentin Clement } 8698c22cb84SValentin Clement 8708c22cb84SValentin Clement /// Generate a sequence of input data transfer calls. 8718c22cb84SValentin Clement static void genInputItemList(Fortran::lower::AbstractConverter &converter, 8728c22cb84SValentin Clement mlir::Value cookie, 8738c22cb84SValentin Clement const std::list<Fortran::parser::InputItem> &items, 8748c22cb84SValentin Clement bool isFormatted, bool checkResult, 8751bffc753SEric Schweitz mlir::Value &ok, bool inLoop) { 8768c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 8778c22cb84SValentin Clement for (const Fortran::parser::InputItem &item : items) { 8788c22cb84SValentin Clement if (const auto &impliedDo = std::get_if<1>(&item.u)) { 8798c22cb84SValentin Clement genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult, 8801bffc753SEric Schweitz ok, inLoop); 8818c22cb84SValentin Clement continue; 8828c22cb84SValentin Clement } 8838c22cb84SValentin Clement auto &pVar = std::get<Fortran::parser::Variable>(item.u); 8848c22cb84SValentin Clement mlir::Location loc = converter.genLocation(pVar.GetSource()); 8858c22cb84SValentin Clement makeNextConditionalOn(builder, loc, checkResult, ok, inLoop); 8861bffc753SEric Schweitz Fortran::lower::StatementContext stmtCtx; 8878c22cb84SValentin Clement const auto *expr = Fortran::semantics::GetExpr(pVar); 8888c22cb84SValentin Clement if (!expr) 8898c22cb84SValentin Clement fir::emitFatalError(loc, "internal error: could not get evaluate::Expr"); 8908c22cb84SValentin Clement if (Fortran::evaluate::HasVectorSubscript(*expr)) { 8919aeb7f03SValentin Clement auto vectorSubscriptBox = 8929aeb7f03SValentin Clement Fortran::lower::genVectorSubscriptBox(loc, converter, stmtCtx, *expr); 8931c7889caSValentin Clement mlir::func::FuncOp inputFunc = getInputFunc( 8949aeb7f03SValentin Clement loc, builder, vectorSubscriptBox.getElementType(), isFormatted); 8954a3460a7SRiver Riddle const bool mustBox = 896fac349a1SChristian Sigg mlir::isa<fir::BoxType>(inputFunc.getFunctionType().getInput(1)); 8979aeb7f03SValentin Clement if (!checkResult) { 8989aeb7f03SValentin Clement auto elementalGenerator = [&](const fir::ExtendedValue &element) { 8996f7a3b07SV Donaldson createIoRuntimeCallForItem(converter, loc, inputFunc, cookie, 9009aeb7f03SValentin Clement mustBox ? builder.createBox(loc, element) 9019aeb7f03SValentin Clement : element); 9029aeb7f03SValentin Clement }; 9039aeb7f03SValentin Clement vectorSubscriptBox.loopOverElements(builder, loc, elementalGenerator); 9049aeb7f03SValentin Clement } else { 9059aeb7f03SValentin Clement auto elementalGenerator = 9069aeb7f03SValentin Clement [&](const fir::ExtendedValue &element) -> mlir::Value { 9079aeb7f03SValentin Clement return createIoRuntimeCallForItem( 9086f7a3b07SV Donaldson converter, loc, inputFunc, cookie, 9099aeb7f03SValentin Clement mustBox ? builder.createBox(loc, element) : element); 9109aeb7f03SValentin Clement }; 9119aeb7f03SValentin Clement if (!ok) 9129aeb7f03SValentin Clement ok = builder.createBool(loc, true); 9139aeb7f03SValentin Clement ok = vectorSubscriptBox.loopOverElementsWhile(builder, loc, 9149aeb7f03SValentin Clement elementalGenerator, ok); 9159aeb7f03SValentin Clement } 9169aeb7f03SValentin Clement continue; 9178c22cb84SValentin Clement } 9188c22cb84SValentin Clement mlir::Type itemTy = converter.genType(*expr); 9191c7889caSValentin Clement mlir::func::FuncOp inputFunc = 9201c7889caSValentin Clement getInputFunc(loc, builder, itemTy, isFormatted); 921fac349a1SChristian Sigg auto itemExv = 922fac349a1SChristian Sigg mlir::isa<fir::BoxType>(inputFunc.getFunctionType().getInput(1)) 9231bffc753SEric Schweitz ? converter.genExprBox(loc, *expr, stmtCtx) 9241bffc753SEric Schweitz : converter.genExprAddr(loc, expr, stmtCtx); 9256f7a3b07SV Donaldson ok = createIoRuntimeCallForItem(converter, loc, inputFunc, cookie, itemExv); 9268c22cb84SValentin Clement } 9278c22cb84SValentin Clement } 9288c22cb84SValentin Clement 9298c22cb84SValentin Clement /// Generate an io-implied-do loop. 9308c22cb84SValentin Clement template <typename D> 9318c22cb84SValentin Clement static void genIoLoop(Fortran::lower::AbstractConverter &converter, 9328c22cb84SValentin Clement mlir::Value cookie, const D &ioImpliedDo, 9338c22cb84SValentin Clement bool isFormatted, bool checkResult, mlir::Value &ok, 9341bffc753SEric Schweitz bool inLoop) { 9351bffc753SEric Schweitz Fortran::lower::StatementContext stmtCtx; 9368c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 9378c22cb84SValentin Clement mlir::Location loc = converter.getCurrentLocation(); 938526553b2SYusuke MINATO mlir::arith::IntegerOverflowFlags flags{}; 939a88677edSYusuke MINATO if (!converter.getLoweringOptions().getIntegerWrapAround()) 940526553b2SYusuke MINATO flags = bitEnumSet(flags, mlir::arith::IntegerOverflowFlags::nsw); 941526553b2SYusuke MINATO auto iofAttr = 942526553b2SYusuke MINATO mlir::arith::IntegerOverflowFlagsAttr::get(builder.getContext(), flags); 9438c22cb84SValentin Clement makeNextConditionalOn(builder, loc, checkResult, ok, inLoop); 9448c22cb84SValentin Clement const auto &itemList = std::get<0>(ioImpliedDo.t); 9458c22cb84SValentin Clement const auto &control = std::get<1>(ioImpliedDo.t); 9468c22cb84SValentin Clement const auto &loopSym = *control.name.thing.thing.symbol; 9471bffc753SEric Schweitz mlir::Value loopVar = fir::getBase(converter.genExprAddr( 9481bffc753SEric Schweitz Fortran::evaluate::AsGenericExpr(loopSym).value(), stmtCtx)); 9498c22cb84SValentin Clement auto genControlValue = [&](const Fortran::parser::ScalarIntExpr &expr) { 9508c22cb84SValentin Clement mlir::Value v = fir::getBase( 9518c22cb84SValentin Clement converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx)); 9528c22cb84SValentin Clement return builder.createConvert(loc, builder.getIndexType(), v); 9538c22cb84SValentin Clement }; 9548c22cb84SValentin Clement mlir::Value lowerValue = genControlValue(control.lower); 9558c22cb84SValentin Clement mlir::Value upperValue = genControlValue(control.upper); 9568c22cb84SValentin Clement mlir::Value stepValue = 9578c22cb84SValentin Clement control.step.has_value() 9588c22cb84SValentin Clement ? genControlValue(*control.step) 9598c22cb84SValentin Clement : builder.create<mlir::arith::ConstantIndexOp>(loc, 1); 9608c22cb84SValentin Clement auto genItemList = [&](const D &ioImpliedDo) { 9618c22cb84SValentin Clement if constexpr (std::is_same_v<D, Fortran::parser::InputImpliedDo>) 9628c22cb84SValentin Clement genInputItemList(converter, cookie, itemList, isFormatted, checkResult, 9631bffc753SEric Schweitz ok, /*inLoop=*/true); 9648c22cb84SValentin Clement else 9658c22cb84SValentin Clement genOutputItemList(converter, cookie, itemList, isFormatted, checkResult, 9661bffc753SEric Schweitz ok, /*inLoop=*/true); 9678c22cb84SValentin Clement }; 9688c22cb84SValentin Clement if (!checkResult) { 9698c22cb84SValentin Clement // No IO call result checks - the loop is a fir.do_loop op. 9708c22cb84SValentin Clement auto doLoopOp = builder.create<fir::DoLoopOp>( 9718c22cb84SValentin Clement loc, lowerValue, upperValue, stepValue, /*unordered=*/false, 9728c22cb84SValentin Clement /*finalCountValue=*/true); 9738c22cb84SValentin Clement builder.setInsertionPointToStart(doLoopOp.getBody()); 9741bffc753SEric Schweitz mlir::Value lcv = builder.createConvert( 9751bffc753SEric Schweitz loc, fir::unwrapRefType(loopVar.getType()), doLoopOp.getInductionVar()); 9768c22cb84SValentin Clement builder.create<fir::StoreOp>(loc, lcv, loopVar); 9778c22cb84SValentin Clement genItemList(ioImpliedDo); 9788c22cb84SValentin Clement builder.setInsertionPointToEnd(doLoopOp.getBody()); 9798c22cb84SValentin Clement mlir::Value result = builder.create<mlir::arith::AddIOp>( 980526553b2SYusuke MINATO loc, doLoopOp.getInductionVar(), doLoopOp.getStep(), iofAttr); 9818c22cb84SValentin Clement builder.create<fir::ResultOp>(loc, result); 9828c22cb84SValentin Clement builder.setInsertionPointAfter(doLoopOp); 9838c22cb84SValentin Clement // The loop control variable may be used after the loop. 9841bffc753SEric Schweitz lcv = builder.createConvert(loc, fir::unwrapRefType(loopVar.getType()), 9858c22cb84SValentin Clement doLoopOp.getResult(0)); 9868c22cb84SValentin Clement builder.create<fir::StoreOp>(loc, lcv, loopVar); 9878c22cb84SValentin Clement return; 9888c22cb84SValentin Clement } 9898c22cb84SValentin Clement // Check IO call results - the loop is a fir.iterate_while op. 9908c22cb84SValentin Clement if (!ok) 9918c22cb84SValentin Clement ok = builder.createBool(loc, true); 9928c22cb84SValentin Clement auto iterWhileOp = builder.create<fir::IterWhileOp>( 9938c22cb84SValentin Clement loc, lowerValue, upperValue, stepValue, ok, /*finalCountValue*/ true); 9948c22cb84SValentin Clement builder.setInsertionPointToStart(iterWhileOp.getBody()); 9951bffc753SEric Schweitz mlir::Value lcv = 9961bffc753SEric Schweitz builder.createConvert(loc, fir::unwrapRefType(loopVar.getType()), 9978c22cb84SValentin Clement iterWhileOp.getInductionVar()); 9988c22cb84SValentin Clement builder.create<fir::StoreOp>(loc, lcv, loopVar); 9998c22cb84SValentin Clement ok = iterWhileOp.getIterateVar(); 10008c22cb84SValentin Clement mlir::Value falseValue = 10018c22cb84SValentin Clement builder.createIntegerConstant(loc, builder.getI1Type(), 0); 10028c22cb84SValentin Clement genItemList(ioImpliedDo); 10038c22cb84SValentin Clement // Unwind nested IO call scopes, filling in true and false ResultOp's. 10048c22cb84SValentin Clement for (mlir::Operation *op = builder.getBlock()->getParentOp(); 10059aeb7f03SValentin Clement mlir::isa<fir::IfOp>(op); op = op->getBlock()->getParentOp()) { 10069aeb7f03SValentin Clement auto ifOp = mlir::dyn_cast<fir::IfOp>(op); 10078c22cb84SValentin Clement mlir::Operation *lastOp = &ifOp.getThenRegion().front().back(); 10088c22cb84SValentin Clement builder.setInsertionPointAfter(lastOp); 10098c22cb84SValentin Clement // The primary ifOp result is the result of an IO call or loop. 10108c22cb84SValentin Clement if (mlir::isa<fir::CallOp, fir::IfOp>(*lastOp)) 10118c22cb84SValentin Clement builder.create<fir::ResultOp>(loc, lastOp->getResult(0)); 10128c22cb84SValentin Clement else 10138c22cb84SValentin Clement builder.create<fir::ResultOp>(loc, ok); // loop result 10148c22cb84SValentin Clement // The else branch propagates an early exit false result. 10158c22cb84SValentin Clement builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); 10168c22cb84SValentin Clement builder.create<fir::ResultOp>(loc, falseValue); 10178c22cb84SValentin Clement } 10188c22cb84SValentin Clement builder.setInsertionPointToEnd(iterWhileOp.getBody()); 10198c22cb84SValentin Clement mlir::OpResult iterateResult = builder.getBlock()->back().getResult(0); 10208c22cb84SValentin Clement mlir::Value inductionResult0 = iterWhileOp.getInductionVar(); 10218c22cb84SValentin Clement auto inductionResult1 = builder.create<mlir::arith::AddIOp>( 1022526553b2SYusuke MINATO loc, inductionResult0, iterWhileOp.getStep(), iofAttr); 10238c22cb84SValentin Clement auto inductionResult = builder.create<mlir::arith::SelectOp>( 10248c22cb84SValentin Clement loc, iterateResult, inductionResult1, inductionResult0); 10258c22cb84SValentin Clement llvm::SmallVector<mlir::Value> results = {inductionResult, iterateResult}; 10268c22cb84SValentin Clement builder.create<fir::ResultOp>(loc, results); 10278c22cb84SValentin Clement ok = iterWhileOp.getResult(1); 10288c22cb84SValentin Clement builder.setInsertionPointAfter(iterWhileOp); 10298c22cb84SValentin Clement // The loop control variable may be used after the loop. 10301bffc753SEric Schweitz lcv = builder.createConvert(loc, fir::unwrapRefType(loopVar.getType()), 10318c22cb84SValentin Clement iterWhileOp.getResult(0)); 10328c22cb84SValentin Clement builder.create<fir::StoreOp>(loc, lcv, loopVar); 10338c22cb84SValentin Clement } 10348c22cb84SValentin Clement 10358c22cb84SValentin Clement //===----------------------------------------------------------------------===// 10368c22cb84SValentin Clement // Default argument generation. 10378c22cb84SValentin Clement //===----------------------------------------------------------------------===// 10388c22cb84SValentin Clement 10398c22cb84SValentin Clement static mlir::Value locToFilename(Fortran::lower::AbstractConverter &converter, 10408c22cb84SValentin Clement mlir::Location loc, mlir::Type toType) { 10418c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 10428c22cb84SValentin Clement return builder.createConvert(loc, toType, 10438c22cb84SValentin Clement fir::factory::locationToFilename(builder, loc)); 10448c22cb84SValentin Clement } 10458c22cb84SValentin Clement 10468c22cb84SValentin Clement static mlir::Value locToLineNo(Fortran::lower::AbstractConverter &converter, 10478c22cb84SValentin Clement mlir::Location loc, mlir::Type toType) { 10488c22cb84SValentin Clement return fir::factory::locationToLineNo(converter.getFirOpBuilder(), loc, 10498c22cb84SValentin Clement toType); 10508c22cb84SValentin Clement } 10518c22cb84SValentin Clement 10528c22cb84SValentin Clement static mlir::Value getDefaultScratch(fir::FirOpBuilder &builder, 10538c22cb84SValentin Clement mlir::Location loc, mlir::Type toType) { 10548c22cb84SValentin Clement mlir::Value null = builder.create<mlir::arith::ConstantOp>( 10558c22cb84SValentin Clement loc, builder.getI64IntegerAttr(0)); 10568c22cb84SValentin Clement return builder.createConvert(loc, toType, null); 10578c22cb84SValentin Clement } 10588c22cb84SValentin Clement 10598c22cb84SValentin Clement static mlir::Value getDefaultScratchLen(fir::FirOpBuilder &builder, 10608c22cb84SValentin Clement mlir::Location loc, mlir::Type toType) { 10618c22cb84SValentin Clement return builder.create<mlir::arith::ConstantOp>( 10628c22cb84SValentin Clement loc, builder.getIntegerAttr(toType, 0)); 10638c22cb84SValentin Clement } 10648c22cb84SValentin Clement 10658c22cb84SValentin Clement /// Generate a reference to a buffer and the length of buffer given 10668c22cb84SValentin Clement /// a character expression. An array expression will be cast to scalar 10678c22cb84SValentin Clement /// character as long as they are contiguous. 10688c22cb84SValentin Clement static std::tuple<mlir::Value, mlir::Value> 10698c22cb84SValentin Clement genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 10708c22cb84SValentin Clement const Fortran::lower::SomeExpr &expr, mlir::Type strTy, 10718c22cb84SValentin Clement mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) { 10728c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 10738c22cb84SValentin Clement fir::ExtendedValue exprAddr = converter.genExprAddr(expr, stmtCtx); 10748c22cb84SValentin Clement fir::factory::CharacterExprHelper helper(builder, loc); 10758c22cb84SValentin Clement using ValuePair = std::pair<mlir::Value, mlir::Value>; 10768c22cb84SValentin Clement auto [buff, len] = exprAddr.match( 10778c22cb84SValentin Clement [&](const fir::CharBoxValue &x) -> ValuePair { 10788c22cb84SValentin Clement return {x.getBuffer(), x.getLen()}; 10798c22cb84SValentin Clement }, 10808c22cb84SValentin Clement [&](const fir::CharArrayBoxValue &x) -> ValuePair { 10818c22cb84SValentin Clement fir::CharBoxValue scalar = helper.toScalarCharacter(x); 10828c22cb84SValentin Clement return {scalar.getBuffer(), scalar.getLen()}; 10838c22cb84SValentin Clement }, 10848c22cb84SValentin Clement [&](const fir::BoxValue &) -> ValuePair { 10858c22cb84SValentin Clement // May need to copy before after IO to handle contiguous 10868c22cb84SValentin Clement // aspect. Not sure descriptor can get here though. 10878c22cb84SValentin Clement TODO(loc, "character descriptor to contiguous buffer"); 10888c22cb84SValentin Clement }, 10898c22cb84SValentin Clement [&](const auto &) -> ValuePair { 10908c22cb84SValentin Clement llvm::report_fatal_error( 10918c22cb84SValentin Clement "internal error: IO buffer is not a character"); 10928c22cb84SValentin Clement }); 10938c22cb84SValentin Clement buff = builder.createConvert(loc, strTy, buff); 10948c22cb84SValentin Clement len = builder.createConvert(loc, lenTy, len); 10958c22cb84SValentin Clement return {buff, len}; 10968c22cb84SValentin Clement } 10978c22cb84SValentin Clement 10988c22cb84SValentin Clement /// Lower a string literal. Many arguments to the runtime are conveyed as 10998c22cb84SValentin Clement /// Fortran CHARACTER literals. 11008c22cb84SValentin Clement template <typename A> 11018c22cb84SValentin Clement static std::tuple<mlir::Value, mlir::Value, mlir::Value> 11028c22cb84SValentin Clement lowerStringLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 11038c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx, const A &syntax, 11048c22cb84SValentin Clement mlir::Type strTy, mlir::Type lenTy, mlir::Type ty2 = {}) { 11058c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 11068c22cb84SValentin Clement auto *expr = Fortran::semantics::GetExpr(syntax); 11078c22cb84SValentin Clement if (!expr) 11088c22cb84SValentin Clement fir::emitFatalError(loc, "internal error: null semantic expr in IO"); 11098c22cb84SValentin Clement auto [buff, len] = genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx); 11108c22cb84SValentin Clement mlir::Value kind; 11118c22cb84SValentin Clement if (ty2) { 11128c22cb84SValentin Clement auto kindVal = expr->GetType().value().kind(); 11138c22cb84SValentin Clement kind = builder.create<mlir::arith::ConstantOp>( 11148c22cb84SValentin Clement loc, builder.getIntegerAttr(ty2, kindVal)); 11158c22cb84SValentin Clement } 11168c22cb84SValentin Clement return {buff, len, kind}; 11178c22cb84SValentin Clement } 11188c22cb84SValentin Clement 11198c22cb84SValentin Clement /// Pass the body of the FORMAT statement in as if it were a CHARACTER literal 11208c22cb84SValentin Clement /// constant. NB: This is the prescribed manner in which the front-end passes 11218c22cb84SValentin Clement /// this information to lowering. 11228c22cb84SValentin Clement static std::tuple<mlir::Value, mlir::Value, mlir::Value> 11238c22cb84SValentin Clement lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter, 11248c22cb84SValentin Clement mlir::Location loc, llvm::StringRef text, 11258c22cb84SValentin Clement mlir::Type strTy, mlir::Type lenTy) { 11268c22cb84SValentin Clement text = text.drop_front(text.find('(')); 11278c22cb84SValentin Clement text = text.take_front(text.rfind(')') + 1); 11288c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 11298c22cb84SValentin Clement mlir::Value addrGlobalStringLit = 11308c22cb84SValentin Clement fir::getBase(fir::factory::createStringLiteral(builder, loc, text)); 11318c22cb84SValentin Clement mlir::Value buff = builder.createConvert(loc, strTy, addrGlobalStringLit); 11328c22cb84SValentin Clement mlir::Value len = builder.createIntegerConstant(loc, lenTy, text.size()); 11338c22cb84SValentin Clement return {buff, len, mlir::Value{}}; 11348c22cb84SValentin Clement } 11358c22cb84SValentin Clement 11368c22cb84SValentin Clement //===----------------------------------------------------------------------===// 11378c22cb84SValentin Clement // Handle IO statement specifiers. 11388c22cb84SValentin Clement // These are threaded together for a single statement via the passed cookie. 11398c22cb84SValentin Clement //===----------------------------------------------------------------------===// 11408c22cb84SValentin Clement 11418c22cb84SValentin Clement /// Generic to build an integral argument to the runtime. 11428c22cb84SValentin Clement template <typename A, typename B> 11438c22cb84SValentin Clement mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter, 11448c22cb84SValentin Clement mlir::Location loc, mlir::Value cookie, 11458c22cb84SValentin Clement const B &spec) { 11468c22cb84SValentin Clement Fortran::lower::StatementContext localStatementCtx; 11478c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 11481c7889caSValentin Clement mlir::func::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder); 11494a3460a7SRiver Riddle mlir::FunctionType ioFuncTy = ioFunc.getFunctionType(); 11508c22cb84SValentin Clement mlir::Value expr = fir::getBase(converter.genExprValue( 11511bffc753SEric Schweitz loc, Fortran::semantics::GetExpr(spec.v), localStatementCtx)); 11528c22cb84SValentin Clement mlir::Value val = builder.createConvert(loc, ioFuncTy.getInput(1), expr); 11538c22cb84SValentin Clement llvm::SmallVector<mlir::Value> ioArgs = {cookie, val}; 11548c22cb84SValentin Clement return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 11558c22cb84SValentin Clement } 11568c22cb84SValentin Clement 11578c22cb84SValentin Clement /// Generic to build a string argument to the runtime. This passes a CHARACTER 11588c22cb84SValentin Clement /// as a pointer to the buffer and a LEN parameter. 11598c22cb84SValentin Clement template <typename A, typename B> 11608c22cb84SValentin Clement mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter, 11618c22cb84SValentin Clement mlir::Location loc, mlir::Value cookie, 11628c22cb84SValentin Clement const B &spec) { 11638c22cb84SValentin Clement Fortran::lower::StatementContext localStatementCtx; 11648c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 11651c7889caSValentin Clement mlir::func::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder); 11664a3460a7SRiver Riddle mlir::FunctionType ioFuncTy = ioFunc.getFunctionType(); 11678c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value, mlir::Value> tup = 11688c22cb84SValentin Clement lowerStringLit(converter, loc, localStatementCtx, spec, 11698c22cb84SValentin Clement ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 11708c22cb84SValentin Clement llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup), 11718c22cb84SValentin Clement std::get<1>(tup)}; 11728c22cb84SValentin Clement return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 11738c22cb84SValentin Clement } 11748c22cb84SValentin Clement 11758c22cb84SValentin Clement template <typename A> 11768c22cb84SValentin Clement mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter, 11778c22cb84SValentin Clement mlir::Location loc, mlir::Value cookie, const A &spec) { 11788c22cb84SValentin Clement // These specifiers are processed in advance elsewhere - skip them here. 11798c22cb84SValentin Clement using PreprocessedSpecs = 11808c22cb84SValentin Clement std::tuple<Fortran::parser::EndLabel, Fortran::parser::EorLabel, 11818c22cb84SValentin Clement Fortran::parser::ErrLabel, Fortran::parser::FileUnitNumber, 11828c22cb84SValentin Clement Fortran::parser::Format, Fortran::parser::IoUnit, 11838c22cb84SValentin Clement Fortran::parser::MsgVariable, Fortran::parser::Name, 11848c22cb84SValentin Clement Fortran::parser::StatVariable>; 11858c22cb84SValentin Clement static_assert(Fortran::common::HasMember<A, PreprocessedSpecs>, 11868c22cb84SValentin Clement "missing genIOOPtion specialization"); 11878c22cb84SValentin Clement return {}; 11888c22cb84SValentin Clement } 11898c22cb84SValentin Clement 11908c22cb84SValentin Clement template <> 11918c22cb84SValentin Clement mlir::Value genIOOption<Fortran::parser::FileNameExpr>( 11928c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 11938c22cb84SValentin Clement mlir::Value cookie, const Fortran::parser::FileNameExpr &spec) { 11948c22cb84SValentin Clement Fortran::lower::StatementContext localStatementCtx; 11958c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 11968c22cb84SValentin Clement // has an extra KIND argument 11971c7889caSValentin Clement mlir::func::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(SetFile)>(loc, builder); 11984a3460a7SRiver Riddle mlir::FunctionType ioFuncTy = ioFunc.getFunctionType(); 11998c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value, mlir::Value> tup = 12008c22cb84SValentin Clement lowerStringLit(converter, loc, localStatementCtx, spec, 12018c22cb84SValentin Clement ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 12028c22cb84SValentin Clement llvm::SmallVector<mlir::Value> ioArgs{cookie, std::get<0>(tup), 12038c22cb84SValentin Clement std::get<1>(tup)}; 12048c22cb84SValentin Clement return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 12058c22cb84SValentin Clement } 12068c22cb84SValentin Clement 12078c22cb84SValentin Clement template <> 12088c22cb84SValentin Clement mlir::Value genIOOption<Fortran::parser::ConnectSpec::CharExpr>( 12098c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 12108c22cb84SValentin Clement mlir::Value cookie, const Fortran::parser::ConnectSpec::CharExpr &spec) { 12118c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 121258ceae95SRiver Riddle mlir::func::FuncOp ioFunc; 12138c22cb84SValentin Clement switch (std::get<Fortran::parser::ConnectSpec::CharExpr::Kind>(spec.t)) { 12148c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Access: 12158c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetAccess)>(loc, builder); 12168c22cb84SValentin Clement break; 12178c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Action: 12188c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetAction)>(loc, builder); 12198c22cb84SValentin Clement break; 12208c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Asynchronous: 12218c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetAsynchronous)>(loc, builder); 12228c22cb84SValentin Clement break; 12238c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Blank: 12248c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder); 12258c22cb84SValentin Clement break; 12268c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Decimal: 12278c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder); 12288c22cb84SValentin Clement break; 12298c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Delim: 12308c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder); 12318c22cb84SValentin Clement break; 12328c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Encoding: 12338c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetEncoding)>(loc, builder); 12348c22cb84SValentin Clement break; 12358c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Form: 12368c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetForm)>(loc, builder); 12378c22cb84SValentin Clement break; 12388c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad: 12398c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder); 12408c22cb84SValentin Clement break; 12418c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Position: 12428c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetPosition)>(loc, builder); 12438c22cb84SValentin Clement break; 12448c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Round: 12458c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder); 12468c22cb84SValentin Clement break; 12478c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Sign: 12488c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder); 12498c22cb84SValentin Clement break; 12508c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Carriagecontrol: 12518c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetCarriagecontrol)>(loc, builder); 12528c22cb84SValentin Clement break; 12538c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert: 125415dc516eSJonathon Penix ioFunc = getIORuntimeFunc<mkIOKey(SetConvert)>(loc, builder); 125515dc516eSJonathon Penix break; 12568c22cb84SValentin Clement case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose: 12578c22cb84SValentin Clement TODO(loc, "DISPOSE not part of the runtime::io interface"); 12588c22cb84SValentin Clement } 12598c22cb84SValentin Clement Fortran::lower::StatementContext localStatementCtx; 12604a3460a7SRiver Riddle mlir::FunctionType ioFuncTy = ioFunc.getFunctionType(); 12618c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value, mlir::Value> tup = 12628c22cb84SValentin Clement lowerStringLit(converter, loc, localStatementCtx, 12638c22cb84SValentin Clement std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t), 12648c22cb84SValentin Clement ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 12658c22cb84SValentin Clement llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup), 12668c22cb84SValentin Clement std::get<1>(tup)}; 12678c22cb84SValentin Clement return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 12688c22cb84SValentin Clement } 12698c22cb84SValentin Clement 12708c22cb84SValentin Clement template <> 12718c22cb84SValentin Clement mlir::Value genIOOption<Fortran::parser::ConnectSpec::Recl>( 12728c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 12738c22cb84SValentin Clement mlir::Value cookie, const Fortran::parser::ConnectSpec::Recl &spec) { 12748c22cb84SValentin Clement return genIntIOOption<mkIOKey(SetRecl)>(converter, loc, cookie, spec); 12758c22cb84SValentin Clement } 12768c22cb84SValentin Clement 12778c22cb84SValentin Clement template <> 12788c22cb84SValentin Clement mlir::Value genIOOption<Fortran::parser::StatusExpr>( 12798c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 12808c22cb84SValentin Clement mlir::Value cookie, const Fortran::parser::StatusExpr &spec) { 12818c22cb84SValentin Clement return genCharIOOption<mkIOKey(SetStatus)>(converter, loc, cookie, spec.v); 12828c22cb84SValentin Clement } 12838c22cb84SValentin Clement 12848c22cb84SValentin Clement template <> 12858c22cb84SValentin Clement mlir::Value genIOOption<Fortran::parser::IoControlSpec::CharExpr>( 12868c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 12878c22cb84SValentin Clement mlir::Value cookie, const Fortran::parser::IoControlSpec::CharExpr &spec) { 12888c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 128958ceae95SRiver Riddle mlir::func::FuncOp ioFunc; 12908c22cb84SValentin Clement switch (std::get<Fortran::parser::IoControlSpec::CharExpr::Kind>(spec.t)) { 12918c22cb84SValentin Clement case Fortran::parser::IoControlSpec::CharExpr::Kind::Advance: 12928c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetAdvance)>(loc, builder); 12938c22cb84SValentin Clement break; 12948c22cb84SValentin Clement case Fortran::parser::IoControlSpec::CharExpr::Kind::Blank: 12958c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder); 12968c22cb84SValentin Clement break; 12978c22cb84SValentin Clement case Fortran::parser::IoControlSpec::CharExpr::Kind::Decimal: 12988c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder); 12998c22cb84SValentin Clement break; 13008c22cb84SValentin Clement case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim: 13018c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder); 13028c22cb84SValentin Clement break; 13038c22cb84SValentin Clement case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad: 13048c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder); 13058c22cb84SValentin Clement break; 13068c22cb84SValentin Clement case Fortran::parser::IoControlSpec::CharExpr::Kind::Round: 13078c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder); 13088c22cb84SValentin Clement break; 13098c22cb84SValentin Clement case Fortran::parser::IoControlSpec::CharExpr::Kind::Sign: 13108c22cb84SValentin Clement ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder); 13118c22cb84SValentin Clement break; 13128c22cb84SValentin Clement } 13138c22cb84SValentin Clement Fortran::lower::StatementContext localStatementCtx; 13144a3460a7SRiver Riddle mlir::FunctionType ioFuncTy = ioFunc.getFunctionType(); 13158c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value, mlir::Value> tup = 13168c22cb84SValentin Clement lowerStringLit(converter, loc, localStatementCtx, 13178c22cb84SValentin Clement std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t), 13188c22cb84SValentin Clement ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 13198c22cb84SValentin Clement llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup), 13208c22cb84SValentin Clement std::get<1>(tup)}; 13218c22cb84SValentin Clement return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 13228c22cb84SValentin Clement } 13238c22cb84SValentin Clement 13248c22cb84SValentin Clement template <> 13258c22cb84SValentin Clement mlir::Value genIOOption<Fortran::parser::IoControlSpec::Asynchronous>( 13268c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 13278c22cb84SValentin Clement mlir::Value cookie, 13288c22cb84SValentin Clement const Fortran::parser::IoControlSpec::Asynchronous &spec) { 13298c22cb84SValentin Clement return genCharIOOption<mkIOKey(SetAsynchronous)>(converter, loc, cookie, 13308c22cb84SValentin Clement spec.v); 13318c22cb84SValentin Clement } 13328c22cb84SValentin Clement 13338c22cb84SValentin Clement template <> 13348c22cb84SValentin Clement mlir::Value genIOOption<Fortran::parser::IoControlSpec::Pos>( 13358c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 13368c22cb84SValentin Clement mlir::Value cookie, const Fortran::parser::IoControlSpec::Pos &spec) { 13378c22cb84SValentin Clement return genIntIOOption<mkIOKey(SetPos)>(converter, loc, cookie, spec); 13388c22cb84SValentin Clement } 13398c22cb84SValentin Clement 13408c22cb84SValentin Clement template <> 13418c22cb84SValentin Clement mlir::Value genIOOption<Fortran::parser::IoControlSpec::Rec>( 13428c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 13438c22cb84SValentin Clement mlir::Value cookie, const Fortran::parser::IoControlSpec::Rec &spec) { 13448c22cb84SValentin Clement return genIntIOOption<mkIOKey(SetRec)>(converter, loc, cookie, spec); 13458c22cb84SValentin Clement } 13468c22cb84SValentin Clement 13474679132aSjeanPerier /// Generate runtime call to set some control variable. 13484679132aSjeanPerier /// Generates "VAR = IoRuntimeKey(cookie)". 13494679132aSjeanPerier template <typename IoRuntimeKey, typename VAR> 13504679132aSjeanPerier static void genIOGetVar(Fortran::lower::AbstractConverter &converter, 13518c22cb84SValentin Clement mlir::Location loc, mlir::Value cookie, 13524679132aSjeanPerier const VAR &parserVar) { 13538c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 13544679132aSjeanPerier mlir::func::FuncOp ioFunc = getIORuntimeFunc<IoRuntimeKey>(loc, builder); 13554679132aSjeanPerier mlir::Value value = 13568c22cb84SValentin Clement builder.create<fir::CallOp>(loc, ioFunc, mlir::ValueRange{cookie}) 13578c22cb84SValentin Clement .getResult(0); 13588c22cb84SValentin Clement Fortran::lower::StatementContext localStatementCtx; 13598c22cb84SValentin Clement fir::ExtendedValue var = converter.genExprAddr( 13604679132aSjeanPerier loc, Fortran::semantics::GetExpr(parserVar.v), localStatementCtx); 13614679132aSjeanPerier builder.createStoreWithConvert(loc, value, fir::getBase(var)); 13628c22cb84SValentin Clement } 13638c22cb84SValentin Clement 13648c22cb84SValentin Clement //===----------------------------------------------------------------------===// 13658c22cb84SValentin Clement // Gather IO statement condition specifier information (if any). 13668c22cb84SValentin Clement //===----------------------------------------------------------------------===// 13678c22cb84SValentin Clement 13688c22cb84SValentin Clement template <typename SEEK, typename A> 13698c22cb84SValentin Clement static bool hasX(const A &list) { 13708c22cb84SValentin Clement for (const auto &spec : list) 13718c22cb84SValentin Clement if (std::holds_alternative<SEEK>(spec.u)) 13728c22cb84SValentin Clement return true; 13738c22cb84SValentin Clement return false; 13748c22cb84SValentin Clement } 13758c22cb84SValentin Clement 1376db48f7b2SValentin Clement template <typename SEEK, typename A> 13779aeb7f03SValentin Clement static bool hasSpec(const A &stmt) { 1378db48f7b2SValentin Clement return hasX<SEEK>(stmt.v); 1379db48f7b2SValentin Clement } 1380db48f7b2SValentin Clement 1381db48f7b2SValentin Clement /// Get the sought expression from the specifier list. 1382db48f7b2SValentin Clement template <typename SEEK, typename A> 1383db48f7b2SValentin Clement static const Fortran::lower::SomeExpr *getExpr(const A &stmt) { 1384db48f7b2SValentin Clement for (const auto &spec : stmt.v) 1385db48f7b2SValentin Clement if (auto *f = std::get_if<SEEK>(&spec.u)) 1386db48f7b2SValentin Clement return Fortran::semantics::GetExpr(f->v); 1387db48f7b2SValentin Clement llvm::report_fatal_error("must have a file unit"); 1388db48f7b2SValentin Clement } 1389db48f7b2SValentin Clement 13908c22cb84SValentin Clement /// For each specifier, build the appropriate call, threading the cookie. 13918c22cb84SValentin Clement template <typename A> 13928c22cb84SValentin Clement static void threadSpecs(Fortran::lower::AbstractConverter &converter, 13938c22cb84SValentin Clement mlir::Location loc, mlir::Value cookie, 13948c22cb84SValentin Clement const A &specList, bool checkResult, mlir::Value &ok) { 13958c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 13968c22cb84SValentin Clement for (const auto &spec : specList) { 13978c22cb84SValentin Clement makeNextConditionalOn(builder, loc, checkResult, ok); 139877d8cfb3SAlexander Shaposhnikov ok = Fortran::common::visit( 13998c22cb84SValentin Clement Fortran::common::visitors{ 14008c22cb84SValentin Clement [&](const Fortran::parser::IoControlSpec::Size &x) -> mlir::Value { 14018c22cb84SValentin Clement // Size must be queried after the related READ runtime calls, not 14028c22cb84SValentin Clement // before. 14038c22cb84SValentin Clement return ok; 14048c22cb84SValentin Clement }, 14059aeb7f03SValentin Clement [&](const Fortran::parser::ConnectSpec::Newunit &x) -> mlir::Value { 14069aeb7f03SValentin Clement // Newunit must be queried after OPEN specifier runtime calls 14079aeb7f03SValentin Clement // that may fail to avoid modifying the newunit variable if 14089aeb7f03SValentin Clement // there is an error. 14099aeb7f03SValentin Clement return ok; 14109aeb7f03SValentin Clement }, 14114679132aSjeanPerier [&](const Fortran::parser::IdVariable &) -> mlir::Value { 14124679132aSjeanPerier // ID is queried after the transfer so that ASYNCHROUNOUS= has 14134679132aSjeanPerier // been processed and also to set it to zero if the transfer is 14144679132aSjeanPerier // already finished. 14154679132aSjeanPerier return ok; 14164679132aSjeanPerier }, 14178c22cb84SValentin Clement [&](const auto &x) { 14188c22cb84SValentin Clement return genIOOption(converter, loc, cookie, x); 14198c22cb84SValentin Clement }}, 14208c22cb84SValentin Clement spec.u); 14218c22cb84SValentin Clement } 14228c22cb84SValentin Clement } 14238c22cb84SValentin Clement 14248c22cb84SValentin Clement /// Most IO statements allow one or more of five optional exception condition 14258c22cb84SValentin Clement /// handling specifiers: ERR, EOR, END, IOSTAT, and IOMSG. The first three 14268c22cb84SValentin Clement /// cause control flow to transfer to another statement. The final two return 14278c22cb84SValentin Clement /// information from the runtime, via a variable, about the nature of the 14288c22cb84SValentin Clement /// condition that occurred. These condition specifiers are handled here. 14298c22cb84SValentin Clement template <typename A> 14301bffc753SEric Schweitz ConditionSpecInfo lowerErrorSpec(Fortran::lower::AbstractConverter &converter, 14311bffc753SEric Schweitz mlir::Location loc, const A &specList) { 14321bffc753SEric Schweitz ConditionSpecInfo csi; 14331bffc753SEric Schweitz const Fortran::lower::SomeExpr *ioMsgExpr = nullptr; 14348c22cb84SValentin Clement for (const auto &spec : specList) { 143577d8cfb3SAlexander Shaposhnikov Fortran::common::visit( 14368c22cb84SValentin Clement Fortran::common::visitors{ 14378c22cb84SValentin Clement [&](const Fortran::parser::StatVariable &var) { 14388c22cb84SValentin Clement csi.ioStatExpr = Fortran::semantics::GetExpr(var); 14398c22cb84SValentin Clement }, 14408c22cb84SValentin Clement [&](const Fortran::parser::InquireSpec::IntVar &var) { 14418c22cb84SValentin Clement if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) == 14428c22cb84SValentin Clement Fortran::parser::InquireSpec::IntVar::Kind::Iostat) 14438c22cb84SValentin Clement csi.ioStatExpr = Fortran::semantics::GetExpr( 14448c22cb84SValentin Clement std::get<Fortran::parser::ScalarIntVariable>(var.t)); 14458c22cb84SValentin Clement }, 14468c22cb84SValentin Clement [&](const Fortran::parser::MsgVariable &var) { 14471bffc753SEric Schweitz ioMsgExpr = Fortran::semantics::GetExpr(var); 14488c22cb84SValentin Clement }, 14498c22cb84SValentin Clement [&](const Fortran::parser::InquireSpec::CharVar &var) { 14508c22cb84SValentin Clement if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>( 14518c22cb84SValentin Clement var.t) == 14528c22cb84SValentin Clement Fortran::parser::InquireSpec::CharVar::Kind::Iomsg) 14531bffc753SEric Schweitz ioMsgExpr = Fortran::semantics::GetExpr( 14548c22cb84SValentin Clement std::get<Fortran::parser::ScalarDefaultCharVariable>( 14558c22cb84SValentin Clement var.t)); 14568c22cb84SValentin Clement }, 14578c22cb84SValentin Clement [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; }, 14588c22cb84SValentin Clement [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; }, 14598c22cb84SValentin Clement [&](const Fortran::parser::ErrLabel &) { csi.hasErr = true; }, 14608c22cb84SValentin Clement [](const auto &) {}}, 14618c22cb84SValentin Clement spec.u); 14628c22cb84SValentin Clement } 14631bffc753SEric Schweitz if (ioMsgExpr) { 14641bffc753SEric Schweitz // iomsg is a variable, its evaluation may require temps, but it cannot 14651bffc753SEric Schweitz // itself be a temp, and it is ok to us a local statement context here. 14661bffc753SEric Schweitz Fortran::lower::StatementContext stmtCtx; 14671bffc753SEric Schweitz csi.ioMsg = converter.genExprAddr(loc, ioMsgExpr, stmtCtx); 14681bffc753SEric Schweitz } 14691bffc753SEric Schweitz 14701bffc753SEric Schweitz return csi; 14711bffc753SEric Schweitz } 14721bffc753SEric Schweitz template <typename A> 14731bffc753SEric Schweitz static void 14741bffc753SEric Schweitz genConditionHandlerCall(Fortran::lower::AbstractConverter &converter, 14751bffc753SEric Schweitz mlir::Location loc, mlir::Value cookie, 14761bffc753SEric Schweitz const A &specList, ConditionSpecInfo &csi) { 14778c22cb84SValentin Clement if (!csi.hasAnyConditionSpec()) 14788c22cb84SValentin Clement return; 14798c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 14801c7889caSValentin Clement mlir::func::FuncOp enableHandlers = 14811c7889caSValentin Clement getIORuntimeFunc<mkIOKey(EnableHandlers)>(loc, builder); 14824a3460a7SRiver Riddle mlir::Type boolType = enableHandlers.getFunctionType().getInput(1); 14838c22cb84SValentin Clement auto boolValue = [&](bool specifierIsPresent) { 14848c22cb84SValentin Clement return builder.create<mlir::arith::ConstantOp>( 14858c22cb84SValentin Clement loc, builder.getIntegerAttr(boolType, specifierIsPresent)); 14868c22cb84SValentin Clement }; 14878c22cb84SValentin Clement llvm::SmallVector<mlir::Value> ioArgs = {cookie, 14888c22cb84SValentin Clement boolValue(csi.ioStatExpr != nullptr), 14898c22cb84SValentin Clement boolValue(csi.hasErr), 14908c22cb84SValentin Clement boolValue(csi.hasEnd), 14918c22cb84SValentin Clement boolValue(csi.hasEor), 14920916d96dSKazu Hirata boolValue(csi.ioMsg.has_value())}; 14938c22cb84SValentin Clement builder.create<fir::CallOp>(loc, enableHandlers, ioArgs); 14948c22cb84SValentin Clement } 14958c22cb84SValentin Clement 14968c22cb84SValentin Clement //===----------------------------------------------------------------------===// 14978c22cb84SValentin Clement // Data transfer helpers 14988c22cb84SValentin Clement //===----------------------------------------------------------------------===// 14998c22cb84SValentin Clement 15008c22cb84SValentin Clement template <typename SEEK, typename A> 15018c22cb84SValentin Clement static bool hasIOControl(const A &stmt) { 15028c22cb84SValentin Clement return hasX<SEEK>(stmt.controls); 15038c22cb84SValentin Clement } 15048c22cb84SValentin Clement 15058c22cb84SValentin Clement template <typename SEEK, typename A> 15068c22cb84SValentin Clement static const auto *getIOControl(const A &stmt) { 15078c22cb84SValentin Clement for (const auto &spec : stmt.controls) 15088c22cb84SValentin Clement if (const auto *result = std::get_if<SEEK>(&spec.u)) 15098c22cb84SValentin Clement return result; 15108c22cb84SValentin Clement return static_cast<const SEEK *>(nullptr); 15118c22cb84SValentin Clement } 15128c22cb84SValentin Clement 15138c22cb84SValentin Clement /// Returns true iff the expression in the parse tree is not really a format but 15148c22cb84SValentin Clement /// rather a namelist group. 15158c22cb84SValentin Clement template <typename A> 15168c22cb84SValentin Clement static bool formatIsActuallyNamelist(const A &format) { 15178c22cb84SValentin Clement if (auto *e = std::get_if<Fortran::parser::Expr>(&format.u)) { 15188c22cb84SValentin Clement auto *expr = Fortran::semantics::GetExpr(*e); 15198c22cb84SValentin Clement if (const Fortran::semantics::Symbol *y = 15208c22cb84SValentin Clement Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) 15218c22cb84SValentin Clement return y->has<Fortran::semantics::NamelistDetails>(); 15228c22cb84SValentin Clement } 15238c22cb84SValentin Clement return false; 15248c22cb84SValentin Clement } 15258c22cb84SValentin Clement 15268c22cb84SValentin Clement template <typename A> 15278c22cb84SValentin Clement static bool isDataTransferFormatted(const A &stmt) { 15288c22cb84SValentin Clement if (stmt.format) 15298c22cb84SValentin Clement return !formatIsActuallyNamelist(*stmt.format); 15308c22cb84SValentin Clement return hasIOControl<Fortran::parser::Format>(stmt); 15318c22cb84SValentin Clement } 15328c22cb84SValentin Clement template <> 15338c22cb84SValentin Clement constexpr bool isDataTransferFormatted<Fortran::parser::PrintStmt>( 15348c22cb84SValentin Clement const Fortran::parser::PrintStmt &) { 15358c22cb84SValentin Clement return true; // PRINT is always formatted 15368c22cb84SValentin Clement } 15378c22cb84SValentin Clement 15388c22cb84SValentin Clement template <typename A> 15398c22cb84SValentin Clement static bool isDataTransferList(const A &stmt) { 15408c22cb84SValentin Clement if (stmt.format) 15418c22cb84SValentin Clement return std::holds_alternative<Fortran::parser::Star>(stmt.format->u); 15428c22cb84SValentin Clement if (auto *mem = getIOControl<Fortran::parser::Format>(stmt)) 15438c22cb84SValentin Clement return std::holds_alternative<Fortran::parser::Star>(mem->u); 15448c22cb84SValentin Clement return false; 15458c22cb84SValentin Clement } 15468c22cb84SValentin Clement template <> 15478c22cb84SValentin Clement bool isDataTransferList<Fortran::parser::PrintStmt>( 15488c22cb84SValentin Clement const Fortran::parser::PrintStmt &stmt) { 15498c22cb84SValentin Clement return std::holds_alternative<Fortran::parser::Star>( 15508c22cb84SValentin Clement std::get<Fortran::parser::Format>(stmt.t).u); 15518c22cb84SValentin Clement } 15528c22cb84SValentin Clement 15538c22cb84SValentin Clement template <typename A> 15548c22cb84SValentin Clement static bool isDataTransferInternal(const A &stmt) { 15558c22cb84SValentin Clement if (stmt.iounit.has_value()) 15568c22cb84SValentin Clement return std::holds_alternative<Fortran::parser::Variable>(stmt.iounit->u); 15578c22cb84SValentin Clement if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt)) 15588c22cb84SValentin Clement return std::holds_alternative<Fortran::parser::Variable>(unit->u); 15598c22cb84SValentin Clement return false; 15608c22cb84SValentin Clement } 15618c22cb84SValentin Clement template <> 15628c22cb84SValentin Clement constexpr bool isDataTransferInternal<Fortran::parser::PrintStmt>( 15638c22cb84SValentin Clement const Fortran::parser::PrintStmt &) { 15648c22cb84SValentin Clement return false; 15658c22cb84SValentin Clement } 15668c22cb84SValentin Clement 15678c22cb84SValentin Clement /// If the variable `var` is an array or of a KIND other than the default 15688c22cb84SValentin Clement /// (normally 1), then a descriptor is required by the runtime IO API. This 15698c22cb84SValentin Clement /// condition holds even in F77 sources. 1570c0921586SKazu Hirata static std::optional<fir::ExtendedValue> getVariableBufferRequiredDescriptor( 1571a02f7505SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 15728c22cb84SValentin Clement const Fortran::parser::Variable &var, 15738c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 15748c22cb84SValentin Clement fir::ExtendedValue varBox = 1575a02f7505SValentin Clement converter.genExprBox(loc, var.typedExpr->v.value(), stmtCtx); 15768c22cb84SValentin Clement fir::KindTy defCharKind = converter.getKindMap().defaultCharacterKind(); 15778c22cb84SValentin Clement mlir::Value varAddr = fir::getBase(varBox); 15788c22cb84SValentin Clement if (fir::factory::CharacterExprHelper::getCharacterOrSequenceKind( 15798c22cb84SValentin Clement varAddr.getType()) != defCharKind) 15808c22cb84SValentin Clement return varBox; 15818c22cb84SValentin Clement if (fir::factory::CharacterExprHelper::isArray(varAddr.getType())) 15828c22cb84SValentin Clement return varBox; 15839a417395SKazu Hirata return std::nullopt; 15848c22cb84SValentin Clement } 15858c22cb84SValentin Clement 15868c22cb84SValentin Clement template <typename A> 1587c0921586SKazu Hirata static std::optional<fir::ExtendedValue> 15888c22cb84SValentin Clement maybeGetInternalIODescriptor(Fortran::lower::AbstractConverter &converter, 1589a02f7505SValentin Clement mlir::Location loc, const A &stmt, 15908c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 15918c22cb84SValentin Clement if (stmt.iounit.has_value()) 15928c22cb84SValentin Clement if (auto *var = std::get_if<Fortran::parser::Variable>(&stmt.iounit->u)) 1593a02f7505SValentin Clement return getVariableBufferRequiredDescriptor(converter, loc, *var, stmtCtx); 15948c22cb84SValentin Clement if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt)) 15958c22cb84SValentin Clement if (auto *var = std::get_if<Fortran::parser::Variable>(&unit->u)) 1596a02f7505SValentin Clement return getVariableBufferRequiredDescriptor(converter, loc, *var, stmtCtx); 15979a417395SKazu Hirata return std::nullopt; 15988c22cb84SValentin Clement } 15998c22cb84SValentin Clement template <> 1600c0921586SKazu Hirata inline std::optional<fir::ExtendedValue> 16018c22cb84SValentin Clement maybeGetInternalIODescriptor<Fortran::parser::PrintStmt>( 1602a02f7505SValentin Clement Fortran::lower::AbstractConverter &, mlir::Location loc, 1603a02f7505SValentin Clement const Fortran::parser::PrintStmt &, Fortran::lower::StatementContext &) { 16049a417395SKazu Hirata return std::nullopt; 16058c22cb84SValentin Clement } 16068c22cb84SValentin Clement 16078c22cb84SValentin Clement template <typename A> 16088c22cb84SValentin Clement static bool isDataTransferNamelist(const A &stmt) { 16098c22cb84SValentin Clement if (stmt.format) 16108c22cb84SValentin Clement return formatIsActuallyNamelist(*stmt.format); 16118c22cb84SValentin Clement return hasIOControl<Fortran::parser::Name>(stmt); 16128c22cb84SValentin Clement } 16138c22cb84SValentin Clement template <> 16148c22cb84SValentin Clement constexpr bool isDataTransferNamelist<Fortran::parser::PrintStmt>( 16158c22cb84SValentin Clement const Fortran::parser::PrintStmt &) { 16168c22cb84SValentin Clement return false; 16178c22cb84SValentin Clement } 16188c22cb84SValentin Clement 16198c22cb84SValentin Clement /// Lowers a format statment that uses an assigned variable label reference as 16208c22cb84SValentin Clement /// a select operation to allow for run-time selection of the format statement. 16218c22cb84SValentin Clement static std::tuple<mlir::Value, mlir::Value, mlir::Value> 16228c22cb84SValentin Clement lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter &converter, 16238c22cb84SValentin Clement mlir::Location loc, 16248c22cb84SValentin Clement const Fortran::lower::SomeExpr &expr, 16258c22cb84SValentin Clement mlir::Type strTy, mlir::Type lenTy, 16268c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 16278c22cb84SValentin Clement // Create the requisite blocks to inline a selectOp. 16288c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 16298c22cb84SValentin Clement mlir::Block *startBlock = builder.getBlock(); 16308c22cb84SValentin Clement mlir::Block *endBlock = startBlock->splitBlock(builder.getInsertionPoint()); 16318c22cb84SValentin Clement mlir::Block *block = startBlock->splitBlock(builder.getInsertionPoint()); 16328c22cb84SValentin Clement builder.setInsertionPointToEnd(block); 16338c22cb84SValentin Clement 16348c22cb84SValentin Clement llvm::SmallVector<int64_t> indexList; 16358c22cb84SValentin Clement llvm::SmallVector<mlir::Block *> blockList; 16368c22cb84SValentin Clement 16378c22cb84SValentin Clement auto symbol = GetLastSymbol(&expr); 16388c22cb84SValentin Clement Fortran::lower::pft::LabelSet labels; 16398c22cb84SValentin Clement converter.lookupLabelSet(*symbol, labels); 16408c22cb84SValentin Clement 16418c22cb84SValentin Clement for (auto label : labels) { 16428c22cb84SValentin Clement indexList.push_back(label); 16438c22cb84SValentin Clement auto *eval = converter.lookupLabel(label); 16448c22cb84SValentin Clement assert(eval && "Label is missing from the table"); 16458c22cb84SValentin Clement 16468c22cb84SValentin Clement llvm::StringRef text = toStringRef(eval->position); 16478c22cb84SValentin Clement mlir::Value stringRef; 16488c22cb84SValentin Clement mlir::Value stringLen; 16498c22cb84SValentin Clement if (eval->isA<Fortran::parser::FormatStmt>()) { 165020f0f15aSKazu Hirata assert(text.contains('(') && "FORMAT is unexpectedly ill-formed"); 16518c22cb84SValentin Clement // This is a format statement, so extract the spec from the text. 16528c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value, mlir::Value> stringLit = 16538c22cb84SValentin Clement lowerSourceTextAsStringLit(converter, loc, text, strTy, lenTy); 16548c22cb84SValentin Clement stringRef = std::get<0>(stringLit); 16558c22cb84SValentin Clement stringLen = std::get<1>(stringLit); 16568c22cb84SValentin Clement } else { 16578c22cb84SValentin Clement // This is not a format statement, so use null. 16588c22cb84SValentin Clement stringRef = builder.createConvert( 16598c22cb84SValentin Clement loc, strTy, 16608c22cb84SValentin Clement builder.createIntegerConstant(loc, builder.getIndexType(), 0)); 16618c22cb84SValentin Clement stringLen = builder.createIntegerConstant(loc, lenTy, 0); 16628c22cb84SValentin Clement } 16638c22cb84SValentin Clement 16648c22cb84SValentin Clement // Pass the format string reference and the string length out of the select 16658c22cb84SValentin Clement // statement. 16668c22cb84SValentin Clement llvm::SmallVector<mlir::Value> args = {stringRef, stringLen}; 16678c22cb84SValentin Clement builder.create<mlir::cf::BranchOp>(loc, endBlock, args); 16688c22cb84SValentin Clement 16698c22cb84SValentin Clement // Add block to the list of cases and make a new one. 16708c22cb84SValentin Clement blockList.push_back(block); 16718c22cb84SValentin Clement block = block->splitBlock(builder.getInsertionPoint()); 16728c22cb84SValentin Clement builder.setInsertionPointToEnd(block); 16738c22cb84SValentin Clement } 16748c22cb84SValentin Clement 16758c22cb84SValentin Clement // Create the unit case which should result in an error. 16768c22cb84SValentin Clement auto *unitBlock = block->splitBlock(builder.getInsertionPoint()); 16778c22cb84SValentin Clement builder.setInsertionPointToEnd(unitBlock); 16781fd72321SV Donaldson fir::runtime::genReportFatalUserError( 16791fd72321SV Donaldson builder, loc, 16801fd72321SV Donaldson "Assigned format variable '" + symbol->name().ToString() + 16811fd72321SV Donaldson "' has not been assigned a valid format label"); 16828c22cb84SValentin Clement builder.create<fir::UnreachableOp>(loc); 16838c22cb84SValentin Clement blockList.push_back(unitBlock); 16848c22cb84SValentin Clement 16858c22cb84SValentin Clement // Lower the selectOp. 16868c22cb84SValentin Clement builder.setInsertionPointToEnd(startBlock); 16871bffc753SEric Schweitz auto label = fir::getBase(converter.genExprValue(loc, &expr, stmtCtx)); 16888c22cb84SValentin Clement builder.create<fir::SelectOp>(loc, label, indexList, blockList); 16898c22cb84SValentin Clement 16908c22cb84SValentin Clement builder.setInsertionPointToEnd(endBlock); 16918c22cb84SValentin Clement endBlock->addArgument(strTy, loc); 16928c22cb84SValentin Clement endBlock->addArgument(lenTy, loc); 16938c22cb84SValentin Clement 16948c22cb84SValentin Clement // Handle and return the string reference and length selected by the selectOp. 16958c22cb84SValentin Clement auto buff = endBlock->getArgument(0); 16968c22cb84SValentin Clement auto len = endBlock->getArgument(1); 16978c22cb84SValentin Clement 16988c22cb84SValentin Clement return {buff, len, mlir::Value{}}; 16998c22cb84SValentin Clement } 17008c22cb84SValentin Clement 17018c22cb84SValentin Clement /// Generate a reference to a format string. There are four cases - a format 17028c22cb84SValentin Clement /// statement label, a character format expression, an integer that holds the 17038c22cb84SValentin Clement /// label of a format statement, and the * case. The first three are done here. 17048c22cb84SValentin Clement /// The * case is done elsewhere. 17058c22cb84SValentin Clement static std::tuple<mlir::Value, mlir::Value, mlir::Value> 17068c22cb84SValentin Clement genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 17078c22cb84SValentin Clement const Fortran::parser::Format &format, mlir::Type strTy, 17088c22cb84SValentin Clement mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) { 17098c22cb84SValentin Clement if (const auto *label = std::get_if<Fortran::parser::Label>(&format.u)) { 17108c22cb84SValentin Clement // format statement label 17118c22cb84SValentin Clement auto eval = converter.lookupLabel(*label); 17128c22cb84SValentin Clement assert(eval && "FORMAT not found in PROCEDURE"); 17138c22cb84SValentin Clement return lowerSourceTextAsStringLit( 17148c22cb84SValentin Clement converter, loc, toStringRef(eval->position), strTy, lenTy); 17158c22cb84SValentin Clement } 17168c22cb84SValentin Clement const auto *pExpr = std::get_if<Fortran::parser::Expr>(&format.u); 17178c22cb84SValentin Clement assert(pExpr && "missing format expression"); 17188c22cb84SValentin Clement auto e = Fortran::semantics::GetExpr(*pExpr); 17198c22cb84SValentin Clement if (Fortran::semantics::ExprHasTypeCategory( 172027d666b9SV Donaldson *e, Fortran::common::TypeCategory::Character)) { 17218c22cb84SValentin Clement // character expression 172227d666b9SV Donaldson if (e->Rank()) 172327d666b9SV Donaldson // Array: return address(descriptor) and no length (and no kind value). 172427d666b9SV Donaldson return {fir::getBase(converter.genExprBox(loc, *e, stmtCtx)), 172527d666b9SV Donaldson mlir::Value{}, mlir::Value{}}; 172627d666b9SV Donaldson // Scalar: return address(format) and format length (and no kind value). 17278c22cb84SValentin Clement return lowerStringLit(converter, loc, stmtCtx, *pExpr, strTy, lenTy); 172827d666b9SV Donaldson } 17298c22cb84SValentin Clement 17308c22cb84SValentin Clement if (Fortran::semantics::ExprHasTypeCategory( 17318c22cb84SValentin Clement *e, Fortran::common::TypeCategory::Integer) && 17328c22cb84SValentin Clement e->Rank() == 0 && Fortran::evaluate::UnwrapWholeSymbolDataRef(*e)) { 17338c22cb84SValentin Clement // Treat as a scalar integer variable containing an ASSIGN label. 17348c22cb84SValentin Clement return lowerReferenceAsStringSelect(converter, loc, *e, strTy, lenTy, 17358c22cb84SValentin Clement stmtCtx); 17368c22cb84SValentin Clement } 17378c22cb84SValentin Clement 17388c22cb84SValentin Clement // Legacy extension: it is possible that `*e` is not a scalar INTEGER 17398c22cb84SValentin Clement // variable containing a label value. The output appears to be the source text 17408c22cb84SValentin Clement // that initialized the variable? Needs more investigatation. 17418c22cb84SValentin Clement TODO(loc, "io-control-spec contains a reference to a non-integer, " 17428c22cb84SValentin Clement "non-scalar, or non-variable"); 17438c22cb84SValentin Clement } 17448c22cb84SValentin Clement 17458c22cb84SValentin Clement template <typename A> 17468c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value, mlir::Value> 17478c22cb84SValentin Clement getFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 17488c22cb84SValentin Clement const A &stmt, mlir::Type strTy, mlir::Type lenTy, 17498c22cb84SValentin Clement Fortran ::lower::StatementContext &stmtCtx) { 17508c22cb84SValentin Clement if (stmt.format && !formatIsActuallyNamelist(*stmt.format)) 17518c22cb84SValentin Clement return genFormat(converter, loc, *stmt.format, strTy, lenTy, stmtCtx); 17528c22cb84SValentin Clement return genFormat(converter, loc, *getIOControl<Fortran::parser::Format>(stmt), 17538c22cb84SValentin Clement strTy, lenTy, stmtCtx); 17548c22cb84SValentin Clement } 17558c22cb84SValentin Clement template <> 17568c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value, mlir::Value> 17578c22cb84SValentin Clement getFormat<Fortran::parser::PrintStmt>( 17588c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 17598c22cb84SValentin Clement const Fortran::parser::PrintStmt &stmt, mlir::Type strTy, mlir::Type lenTy, 17608c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 17618c22cb84SValentin Clement return genFormat(converter, loc, std::get<Fortran::parser::Format>(stmt.t), 17628c22cb84SValentin Clement strTy, lenTy, stmtCtx); 17638c22cb84SValentin Clement } 17648c22cb84SValentin Clement 17658c22cb84SValentin Clement /// Get a buffer for an internal file data transfer. 17668c22cb84SValentin Clement template <typename A> 17678c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value> 17688c22cb84SValentin Clement getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 17698c22cb84SValentin Clement const A &stmt, mlir::Type strTy, mlir::Type lenTy, 17708c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 17718c22cb84SValentin Clement const Fortran::parser::IoUnit *iounit = 17728c22cb84SValentin Clement stmt.iounit ? &*stmt.iounit : getIOControl<Fortran::parser::IoUnit>(stmt); 17738c22cb84SValentin Clement if (iounit) 17748c22cb84SValentin Clement if (auto *var = std::get_if<Fortran::parser::Variable>(&iounit->u)) 17758c22cb84SValentin Clement if (auto *expr = Fortran::semantics::GetExpr(*var)) 17768c22cb84SValentin Clement return genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx); 177739377d52SValentin Clement llvm::report_fatal_error("failed to get IoUnit expr"); 17788c22cb84SValentin Clement } 17798c22cb84SValentin Clement 17801bffc753SEric Schweitz static mlir::Value genIOUnitNumber(Fortran::lower::AbstractConverter &converter, 17818c22cb84SValentin Clement mlir::Location loc, 17821bffc753SEric Schweitz const Fortran::lower::SomeExpr *iounit, 17831bffc753SEric Schweitz mlir::Type ty, ConditionSpecInfo &csi, 17848c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 17858c22cb84SValentin Clement auto &builder = converter.getFirOpBuilder(); 17861bffc753SEric Schweitz auto rawUnit = fir::getBase(converter.genExprValue(loc, iounit, stmtCtx)); 17871bffc753SEric Schweitz unsigned rawUnitWidth = 1788fac349a1SChristian Sigg mlir::cast<mlir::IntegerType>(rawUnit.getType()).getWidth(); 1789fac349a1SChristian Sigg unsigned runtimeArgWidth = mlir::cast<mlir::IntegerType>(ty).getWidth(); 17901bffc753SEric Schweitz // The IO runtime supports `int` unit numbers, if the unit number may 17911bffc753SEric Schweitz // overflow when passed to the IO runtime, check that the unit number is 17921bffc753SEric Schweitz // in range before calling the BeginXXX. 17931bffc753SEric Schweitz if (rawUnitWidth > runtimeArgWidth) { 17941c7889caSValentin Clement mlir::func::FuncOp check = 17951bffc753SEric Schweitz rawUnitWidth <= 64 17961bffc753SEric Schweitz ? getIORuntimeFunc<mkIOKey(CheckUnitNumberInRange64)>(loc, builder) 17971bffc753SEric Schweitz : getIORuntimeFunc<mkIOKey(CheckUnitNumberInRange128)>(loc, 17981bffc753SEric Schweitz builder); 17991bffc753SEric Schweitz mlir::FunctionType funcTy = check.getFunctionType(); 18001bffc753SEric Schweitz llvm::SmallVector<mlir::Value> args; 18011bffc753SEric Schweitz args.push_back(builder.createConvert(loc, funcTy.getInput(0), rawUnit)); 18021bffc753SEric Schweitz args.push_back(builder.createBool(loc, csi.hasErrorConditionSpec())); 18031bffc753SEric Schweitz if (csi.ioMsg) { 18041bffc753SEric Schweitz args.push_back(builder.createConvert(loc, funcTy.getInput(2), 18051bffc753SEric Schweitz fir::getBase(*csi.ioMsg))); 18061bffc753SEric Schweitz args.push_back(builder.createConvert(loc, funcTy.getInput(3), 18071bffc753SEric Schweitz fir::getLen(*csi.ioMsg))); 18081bffc753SEric Schweitz } else { 18091bffc753SEric Schweitz args.push_back(builder.createNullConstant(loc, funcTy.getInput(2))); 18101bffc753SEric Schweitz args.push_back( 18111bffc753SEric Schweitz fir::factory::createZeroValue(builder, loc, funcTy.getInput(3))); 18128c22cb84SValentin Clement } 18131bffc753SEric Schweitz mlir::Value file = locToFilename(converter, loc, funcTy.getInput(4)); 18141bffc753SEric Schweitz mlir::Value line = locToLineNo(converter, loc, funcTy.getInput(5)); 18151bffc753SEric Schweitz args.push_back(file); 18161bffc753SEric Schweitz args.push_back(line); 18171bffc753SEric Schweitz auto checkCall = builder.create<fir::CallOp>(loc, check, args); 18181bffc753SEric Schweitz if (csi.hasErrorConditionSpec()) { 18191bffc753SEric Schweitz mlir::Value iostat = checkCall.getResult(0); 18201bffc753SEric Schweitz mlir::Type iostatTy = iostat.getType(); 18211bffc753SEric Schweitz mlir::Value zero = fir::factory::createZeroValue(builder, loc, iostatTy); 18221bffc753SEric Schweitz mlir::Value unitIsOK = builder.create<mlir::arith::CmpIOp>( 18231bffc753SEric Schweitz loc, mlir::arith::CmpIPredicate::eq, iostat, zero); 18241bffc753SEric Schweitz auto ifOp = builder.create<fir::IfOp>(loc, iostatTy, unitIsOK, 18251bffc753SEric Schweitz /*withElseRegion=*/true); 18261bffc753SEric Schweitz builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); 18271bffc753SEric Schweitz builder.create<fir::ResultOp>(loc, iostat); 18281bffc753SEric Schweitz builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); 18291bffc753SEric Schweitz stmtCtx.pushScope(); 18301bffc753SEric Schweitz csi.bigUnitIfOp = ifOp; 18311bffc753SEric Schweitz } 18321bffc753SEric Schweitz } 18331bffc753SEric Schweitz return builder.createConvert(loc, ty, rawUnit); 18341bffc753SEric Schweitz } 18351bffc753SEric Schweitz 18361bffc753SEric Schweitz static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter, 18371bffc753SEric Schweitz mlir::Location loc, 18381bffc753SEric Schweitz const Fortran::parser::IoUnit *iounit, 18391bffc753SEric Schweitz mlir::Type ty, ConditionSpecInfo &csi, 18408f3357b7SPeter Klausler Fortran::lower::StatementContext &stmtCtx, 18418f3357b7SPeter Klausler int defaultUnitNumber) { 18421bffc753SEric Schweitz auto &builder = converter.getFirOpBuilder(); 18431bffc753SEric Schweitz if (iounit) 18441bffc753SEric Schweitz if (auto *e = std::get_if<Fortran::parser::FileUnitNumber>(&iounit->u)) 18451bffc753SEric Schweitz return genIOUnitNumber(converter, loc, Fortran::semantics::GetExpr(*e), 18461bffc753SEric Schweitz ty, csi, stmtCtx); 18478c22cb84SValentin Clement return builder.create<mlir::arith::ConstantOp>( 18488f3357b7SPeter Klausler loc, builder.getIntegerAttr(ty, defaultUnitNumber)); 18498c22cb84SValentin Clement } 18508c22cb84SValentin Clement 18518c22cb84SValentin Clement template <typename A> 18528f3357b7SPeter Klausler static mlir::Value 18538f3357b7SPeter Klausler getIOUnit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 18548f3357b7SPeter Klausler const A &stmt, mlir::Type ty, ConditionSpecInfo &csi, 18558f3357b7SPeter Klausler Fortran::lower::StatementContext &stmtCtx, int defaultUnitNumber) { 18561bffc753SEric Schweitz const Fortran::parser::IoUnit *iounit = 18571bffc753SEric Schweitz stmt.iounit ? &*stmt.iounit : getIOControl<Fortran::parser::IoUnit>(stmt); 18588f3357b7SPeter Klausler return genIOUnit(converter, loc, iounit, ty, csi, stmtCtx, defaultUnitNumber); 18598c22cb84SValentin Clement } 18608c22cb84SValentin Clement //===----------------------------------------------------------------------===// 1861db48f7b2SValentin Clement // Generators for each IO statement type. 1862db48f7b2SValentin Clement //===----------------------------------------------------------------------===// 1863db48f7b2SValentin Clement 1864db48f7b2SValentin Clement template <typename K, typename S> 1865db48f7b2SValentin Clement static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter, 1866db48f7b2SValentin Clement const S &stmt) { 1867db48f7b2SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 1868db48f7b2SValentin Clement Fortran::lower::StatementContext stmtCtx; 1869db48f7b2SValentin Clement mlir::Location loc = converter.getCurrentLocation(); 18701bffc753SEric Schweitz ConditionSpecInfo csi = lowerErrorSpec(converter, loc, stmt.v); 18711c7889caSValentin Clement mlir::func::FuncOp beginFunc = getIORuntimeFunc<K>(loc, builder); 18724a3460a7SRiver Riddle mlir::FunctionType beginFuncTy = beginFunc.getFunctionType(); 18731bffc753SEric Schweitz mlir::Value unit = genIOUnitNumber( 18741bffc753SEric Schweitz converter, loc, getExpr<Fortran::parser::FileUnitNumber>(stmt), 18751bffc753SEric Schweitz beginFuncTy.getInput(0), csi, stmtCtx); 1876db48f7b2SValentin Clement mlir::Value un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1877db48f7b2SValentin Clement mlir::Value file = locToFilename(converter, loc, beginFuncTy.getInput(1)); 1878db48f7b2SValentin Clement mlir::Value line = locToLineNo(converter, loc, beginFuncTy.getInput(2)); 1879db48f7b2SValentin Clement auto call = builder.create<fir::CallOp>(loc, beginFunc, 1880db48f7b2SValentin Clement mlir::ValueRange{un, file, line}); 1881db48f7b2SValentin Clement mlir::Value cookie = call.getResult(0); 1882db48f7b2SValentin Clement genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1883db48f7b2SValentin Clement mlir::Value ok; 1884db48f7b2SValentin Clement auto insertPt = builder.saveInsertionPoint(); 1885db48f7b2SValentin Clement threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok); 1886db48f7b2SValentin Clement builder.restoreInsertionPoint(insertPt); 1887db48f7b2SValentin Clement return genEndIO(converter, converter.getCurrentLocation(), cookie, csi, 1888db48f7b2SValentin Clement stmtCtx); 1889db48f7b2SValentin Clement } 1890db48f7b2SValentin Clement 189146f46a37SValentin Clement mlir::Value Fortran::lower::genBackspaceStatement( 189246f46a37SValentin Clement Fortran::lower::AbstractConverter &converter, 189346f46a37SValentin Clement const Fortran::parser::BackspaceStmt &stmt) { 189446f46a37SValentin Clement return genBasicIOStmt<mkIOKey(BeginBackspace)>(converter, stmt); 189546f46a37SValentin Clement } 189646f46a37SValentin Clement 189746f46a37SValentin Clement mlir::Value Fortran::lower::genEndfileStatement( 189846f46a37SValentin Clement Fortran::lower::AbstractConverter &converter, 189946f46a37SValentin Clement const Fortran::parser::EndfileStmt &stmt) { 190046f46a37SValentin Clement return genBasicIOStmt<mkIOKey(BeginEndfile)>(converter, stmt); 190146f46a37SValentin Clement } 190246f46a37SValentin Clement 190346f46a37SValentin Clement mlir::Value 190446f46a37SValentin Clement Fortran::lower::genFlushStatement(Fortran::lower::AbstractConverter &converter, 190546f46a37SValentin Clement const Fortran::parser::FlushStmt &stmt) { 190646f46a37SValentin Clement return genBasicIOStmt<mkIOKey(BeginFlush)>(converter, stmt); 190746f46a37SValentin Clement } 190846f46a37SValentin Clement 190946f46a37SValentin Clement mlir::Value 191046f46a37SValentin Clement Fortran::lower::genRewindStatement(Fortran::lower::AbstractConverter &converter, 191146f46a37SValentin Clement const Fortran::parser::RewindStmt &stmt) { 191246f46a37SValentin Clement return genBasicIOStmt<mkIOKey(BeginRewind)>(converter, stmt); 191346f46a37SValentin Clement } 191446f46a37SValentin Clement 19159aeb7f03SValentin Clement static mlir::Value 19169aeb7f03SValentin Clement genNewunitSpec(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 19179aeb7f03SValentin Clement mlir::Value cookie, 19189aeb7f03SValentin Clement const std::list<Fortran::parser::ConnectSpec> &specList) { 19199aeb7f03SValentin Clement for (const auto &spec : specList) 19209aeb7f03SValentin Clement if (auto *newunit = 19219aeb7f03SValentin Clement std::get_if<Fortran::parser::ConnectSpec::Newunit>(&spec.u)) { 19229aeb7f03SValentin Clement Fortran::lower::StatementContext stmtCtx; 19239aeb7f03SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 19241c7889caSValentin Clement mlir::func::FuncOp ioFunc = 19251c7889caSValentin Clement getIORuntimeFunc<mkIOKey(GetNewUnit)>(loc, builder); 19264a3460a7SRiver Riddle mlir::FunctionType ioFuncTy = ioFunc.getFunctionType(); 19279aeb7f03SValentin Clement const auto *var = Fortran::semantics::GetExpr(newunit->v); 19289aeb7f03SValentin Clement mlir::Value addr = builder.createConvert( 19299aeb7f03SValentin Clement loc, ioFuncTy.getInput(1), 19301bffc753SEric Schweitz fir::getBase(converter.genExprAddr(loc, var, stmtCtx))); 19319aeb7f03SValentin Clement auto kind = builder.createIntegerConstant(loc, ioFuncTy.getInput(2), 19329aeb7f03SValentin Clement var->GetType().value().kind()); 19339aeb7f03SValentin Clement llvm::SmallVector<mlir::Value> ioArgs = {cookie, addr, kind}; 19349aeb7f03SValentin Clement return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 19359aeb7f03SValentin Clement } 19369aeb7f03SValentin Clement llvm_unreachable("missing Newunit spec"); 19379aeb7f03SValentin Clement } 19389aeb7f03SValentin Clement 1939db48f7b2SValentin Clement mlir::Value 1940db48f7b2SValentin Clement Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter, 1941db48f7b2SValentin Clement const Fortran::parser::OpenStmt &stmt) { 1942db48f7b2SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 1943db48f7b2SValentin Clement Fortran::lower::StatementContext stmtCtx; 194458ceae95SRiver Riddle mlir::func::FuncOp beginFunc; 1945db48f7b2SValentin Clement llvm::SmallVector<mlir::Value> beginArgs; 1946db48f7b2SValentin Clement mlir::Location loc = converter.getCurrentLocation(); 19471bffc753SEric Schweitz ConditionSpecInfo csi = lowerErrorSpec(converter, loc, stmt.v); 19489aeb7f03SValentin Clement bool hasNewunitSpec = false; 19499aeb7f03SValentin Clement if (hasSpec<Fortran::parser::FileUnitNumber>(stmt)) { 1950db48f7b2SValentin Clement beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenUnit)>(loc, builder); 19514a3460a7SRiver Riddle mlir::FunctionType beginFuncTy = beginFunc.getFunctionType(); 19521bffc753SEric Schweitz mlir::Value unit = genIOUnitNumber( 19531bffc753SEric Schweitz converter, loc, getExpr<Fortran::parser::FileUnitNumber>(stmt), 19541bffc753SEric Schweitz beginFuncTy.getInput(0), csi, stmtCtx); 19551bffc753SEric Schweitz beginArgs.push_back(unit); 1956db48f7b2SValentin Clement beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(1))); 1957db48f7b2SValentin Clement beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(2))); 1958db48f7b2SValentin Clement } else { 19599aeb7f03SValentin Clement hasNewunitSpec = hasSpec<Fortran::parser::ConnectSpec::Newunit>(stmt); 19609aeb7f03SValentin Clement assert(hasNewunitSpec && "missing unit specifier"); 1961db48f7b2SValentin Clement beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenNewUnit)>(loc, builder); 19624a3460a7SRiver Riddle mlir::FunctionType beginFuncTy = beginFunc.getFunctionType(); 1963db48f7b2SValentin Clement beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(0))); 1964db48f7b2SValentin Clement beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(1))); 1965db48f7b2SValentin Clement } 1966db48f7b2SValentin Clement auto cookie = 1967db48f7b2SValentin Clement builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1968db48f7b2SValentin Clement genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1969db48f7b2SValentin Clement mlir::Value ok; 1970db48f7b2SValentin Clement auto insertPt = builder.saveInsertionPoint(); 1971db48f7b2SValentin Clement threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok); 19729aeb7f03SValentin Clement if (hasNewunitSpec) 19739aeb7f03SValentin Clement genNewunitSpec(converter, loc, cookie, stmt.v); 1974db48f7b2SValentin Clement builder.restoreInsertionPoint(insertPt); 1975db48f7b2SValentin Clement return genEndIO(converter, loc, cookie, csi, stmtCtx); 1976db48f7b2SValentin Clement } 1977db48f7b2SValentin Clement 1978db48f7b2SValentin Clement mlir::Value 1979db48f7b2SValentin Clement Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter &converter, 1980db48f7b2SValentin Clement const Fortran::parser::CloseStmt &stmt) { 1981db48f7b2SValentin Clement return genBasicIOStmt<mkIOKey(BeginClose)>(converter, stmt); 1982db48f7b2SValentin Clement } 1983db48f7b2SValentin Clement 198446f46a37SValentin Clement mlir::Value 198546f46a37SValentin Clement Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter, 198646f46a37SValentin Clement const Fortran::parser::WaitStmt &stmt) { 198746f46a37SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 198846f46a37SValentin Clement Fortran::lower::StatementContext stmtCtx; 198946f46a37SValentin Clement mlir::Location loc = converter.getCurrentLocation(); 19901bffc753SEric Schweitz ConditionSpecInfo csi = lowerErrorSpec(converter, loc, stmt.v); 19919aeb7f03SValentin Clement bool hasId = hasSpec<Fortran::parser::IdExpr>(stmt); 19921c7889caSValentin Clement mlir::func::FuncOp beginFunc = 19931c7889caSValentin Clement hasId ? getIORuntimeFunc<mkIOKey(BeginWait)>(loc, builder) 199446f46a37SValentin Clement : getIORuntimeFunc<mkIOKey(BeginWaitAll)>(loc, builder); 19954a3460a7SRiver Riddle mlir::FunctionType beginFuncTy = beginFunc.getFunctionType(); 19961bffc753SEric Schweitz mlir::Value unit = genIOUnitNumber( 19971bffc753SEric Schweitz converter, loc, getExpr<Fortran::parser::FileUnitNumber>(stmt), 19981bffc753SEric Schweitz beginFuncTy.getInput(0), csi, stmtCtx); 19991bffc753SEric Schweitz llvm::SmallVector<mlir::Value> args{unit}; 200046f46a37SValentin Clement if (hasId) { 200146f46a37SValentin Clement mlir::Value id = fir::getBase(converter.genExprValue( 20021bffc753SEric Schweitz loc, getExpr<Fortran::parser::IdExpr>(stmt), stmtCtx)); 200346f46a37SValentin Clement args.push_back(builder.createConvert(loc, beginFuncTy.getInput(1), id)); 2004df417c37SValentin Clement args.push_back(locToFilename(converter, loc, beginFuncTy.getInput(2))); 2005df417c37SValentin Clement args.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(3))); 2006df417c37SValentin Clement } else { 2007df417c37SValentin Clement args.push_back(locToFilename(converter, loc, beginFuncTy.getInput(1))); 2008df417c37SValentin Clement args.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(2))); 200946f46a37SValentin Clement } 201046f46a37SValentin Clement auto cookie = builder.create<fir::CallOp>(loc, beginFunc, args).getResult(0); 201146f46a37SValentin Clement genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 201246f46a37SValentin Clement return genEndIO(converter, converter.getCurrentLocation(), cookie, csi, 201346f46a37SValentin Clement stmtCtx); 201446f46a37SValentin Clement } 201546f46a37SValentin Clement 2016db48f7b2SValentin Clement //===----------------------------------------------------------------------===// 20178c22cb84SValentin Clement // Data transfer statements. 20188c22cb84SValentin Clement // 20198c22cb84SValentin Clement // There are several dimensions to the API with regard to data transfer 20208c22cb84SValentin Clement // statements that need to be considered. 20218c22cb84SValentin Clement // 20228c22cb84SValentin Clement // - input (READ) vs. output (WRITE, PRINT) 20238c22cb84SValentin Clement // - unformatted vs. formatted vs. list vs. namelist 20248c22cb84SValentin Clement // - synchronous vs. asynchronous 20258c22cb84SValentin Clement // - external vs. internal 20268c22cb84SValentin Clement //===----------------------------------------------------------------------===// 20278c22cb84SValentin Clement 20288c22cb84SValentin Clement // Get the begin data transfer IO function to call for the given values. 20298c22cb84SValentin Clement template <bool isInput> 203058ceae95SRiver Riddle mlir::func::FuncOp 20318c22cb84SValentin Clement getBeginDataTransferFunc(mlir::Location loc, fir::FirOpBuilder &builder, 20328c22cb84SValentin Clement bool isFormatted, bool isListOrNml, bool isInternal, 20334679132aSjeanPerier bool isInternalWithDesc) { 20348c22cb84SValentin Clement if constexpr (isInput) { 20358c22cb84SValentin Clement if (isFormatted || isListOrNml) { 20368c22cb84SValentin Clement if (isInternal) { 20378c22cb84SValentin Clement if (isInternalWithDesc) { 20388c22cb84SValentin Clement if (isListOrNml) 20398c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginInternalArrayListInput)>( 20408c22cb84SValentin Clement loc, builder); 20418c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedInput)>( 20428c22cb84SValentin Clement loc, builder); 20438c22cb84SValentin Clement } 20448c22cb84SValentin Clement if (isListOrNml) 20458c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginInternalListInput)>(loc, 20468c22cb84SValentin Clement builder); 20478c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginInternalFormattedInput)>(loc, 20488c22cb84SValentin Clement builder); 20498c22cb84SValentin Clement } 20508c22cb84SValentin Clement if (isListOrNml) 20518c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginExternalListInput)>(loc, builder); 20528c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginExternalFormattedInput)>(loc, 20538c22cb84SValentin Clement builder); 20548c22cb84SValentin Clement } 20558c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginUnformattedInput)>(loc, builder); 20568c22cb84SValentin Clement } else { 20578c22cb84SValentin Clement if (isFormatted || isListOrNml) { 20588c22cb84SValentin Clement if (isInternal) { 20598c22cb84SValentin Clement if (isInternalWithDesc) { 20608c22cb84SValentin Clement if (isListOrNml) 20618c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginInternalArrayListOutput)>( 20628c22cb84SValentin Clement loc, builder); 20638c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedOutput)>( 20648c22cb84SValentin Clement loc, builder); 20658c22cb84SValentin Clement } 20668c22cb84SValentin Clement if (isListOrNml) 20678c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginInternalListOutput)>(loc, 20688c22cb84SValentin Clement builder); 20698c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginInternalFormattedOutput)>(loc, 20708c22cb84SValentin Clement builder); 20718c22cb84SValentin Clement } 20728c22cb84SValentin Clement if (isListOrNml) 20738c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginExternalListOutput)>(loc, builder); 20748c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginExternalFormattedOutput)>(loc, 20758c22cb84SValentin Clement builder); 20768c22cb84SValentin Clement } 20778c22cb84SValentin Clement return getIORuntimeFunc<mkIOKey(BeginUnformattedOutput)>(loc, builder); 20788c22cb84SValentin Clement } 20798c22cb84SValentin Clement } 20808c22cb84SValentin Clement 20818c22cb84SValentin Clement /// Generate the arguments of a begin data transfer statement call. 20828f3357b7SPeter Klausler template <bool hasIOCtrl, int defaultUnitNumber, typename A> 20838c22cb84SValentin Clement void genBeginDataTransferCallArgs( 20848c22cb84SValentin Clement llvm::SmallVectorImpl<mlir::Value> &ioArgs, 20858c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 20868c22cb84SValentin Clement const A &stmt, mlir::FunctionType ioFuncTy, bool isFormatted, 20878c22cb84SValentin Clement bool isListOrNml, [[maybe_unused]] bool isInternal, 2088c0921586SKazu Hirata const std::optional<fir::ExtendedValue> &descRef, ConditionSpecInfo &csi, 20898c22cb84SValentin Clement Fortran::lower::StatementContext &stmtCtx) { 20908c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 20918c22cb84SValentin Clement auto maybeGetFormatArgs = [&]() { 20928c22cb84SValentin Clement if (!isFormatted || isListOrNml) 20938c22cb84SValentin Clement return; 209427d666b9SV Donaldson std::tuple triple = 20958c22cb84SValentin Clement getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 20968c22cb84SValentin Clement ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx); 209727d666b9SV Donaldson mlir::Value address = std::get<0>(triple); 209827d666b9SV Donaldson mlir::Value length = std::get<1>(triple); 209927d666b9SV Donaldson if (length) { 210027d666b9SV Donaldson // Scalar format: string arg + length arg; no format descriptor arg 210127d666b9SV Donaldson ioArgs.push_back(address); // format string 210227d666b9SV Donaldson ioArgs.push_back(length); // format length 210327d666b9SV Donaldson ioArgs.push_back( 210427d666b9SV Donaldson builder.createNullConstant(loc, ioFuncTy.getInput(ioArgs.size()))); 210527d666b9SV Donaldson return; 210627d666b9SV Donaldson } 210727d666b9SV Donaldson // Array format: no string arg, no length arg; format descriptor arg 210827d666b9SV Donaldson ioArgs.push_back( 210927d666b9SV Donaldson builder.createNullConstant(loc, ioFuncTy.getInput(ioArgs.size()))); 211027d666b9SV Donaldson ioArgs.push_back( 211127d666b9SV Donaldson builder.createNullConstant(loc, ioFuncTy.getInput(ioArgs.size()))); 211227d666b9SV Donaldson ioArgs.push_back( // format descriptor 211327d666b9SV Donaldson builder.createConvert(loc, ioFuncTy.getInput(ioArgs.size()), address)); 21148c22cb84SValentin Clement }; 21158c22cb84SValentin Clement if constexpr (hasIOCtrl) { // READ or WRITE 21168c22cb84SValentin Clement if (isInternal) { 21178c22cb84SValentin Clement // descriptor or scalar variable; maybe explicit format; scratch area 21185413bf1bSKazu Hirata if (descRef) { 21198c22cb84SValentin Clement mlir::Value desc = builder.createBox(loc, *descRef); 21208c22cb84SValentin Clement ioArgs.push_back( 21218c22cb84SValentin Clement builder.createConvert(loc, ioFuncTy.getInput(ioArgs.size()), desc)); 21228c22cb84SValentin Clement } else { 21238c22cb84SValentin Clement std::tuple<mlir::Value, mlir::Value> pair = 21248c22cb84SValentin Clement getBuffer(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 21258c22cb84SValentin Clement ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx); 21268c22cb84SValentin Clement ioArgs.push_back(std::get<0>(pair)); // scalar character variable 21278c22cb84SValentin Clement ioArgs.push_back(std::get<1>(pair)); // character length 21288c22cb84SValentin Clement } 21298c22cb84SValentin Clement maybeGetFormatArgs(); 21308c22cb84SValentin Clement ioArgs.push_back( // internal scratch area buffer 21318c22cb84SValentin Clement getDefaultScratch(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 21328c22cb84SValentin Clement ioArgs.push_back( // buffer length 21338c22cb84SValentin Clement getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 21348c22cb84SValentin Clement } else { // external IO - maybe explicit format; unit 21358c22cb84SValentin Clement maybeGetFormatArgs(); 21368c22cb84SValentin Clement ioArgs.push_back(getIOUnit(converter, loc, stmt, 21378f3357b7SPeter Klausler ioFuncTy.getInput(ioArgs.size()), csi, stmtCtx, 21388f3357b7SPeter Klausler defaultUnitNumber)); 21398c22cb84SValentin Clement } 21408c22cb84SValentin Clement } else { // PRINT - maybe explicit format; default unit 21418c22cb84SValentin Clement maybeGetFormatArgs(); 21428c22cb84SValentin Clement ioArgs.push_back(builder.create<mlir::arith::ConstantOp>( 21438c22cb84SValentin Clement loc, builder.getIntegerAttr(ioFuncTy.getInput(ioArgs.size()), 21448f3357b7SPeter Klausler defaultUnitNumber))); 21458c22cb84SValentin Clement } 214627d666b9SV Donaldson // File name and line number are always the last two arguments. 21478c22cb84SValentin Clement ioArgs.push_back( 21488c22cb84SValentin Clement locToFilename(converter, loc, ioFuncTy.getInput(ioArgs.size()))); 21498c22cb84SValentin Clement ioArgs.push_back( 21508c22cb84SValentin Clement locToLineNo(converter, loc, ioFuncTy.getInput(ioArgs.size()))); 21518c22cb84SValentin Clement } 21528c22cb84SValentin Clement 21538c22cb84SValentin Clement template <bool isInput, bool hasIOCtrl = true, typename A> 21548c22cb84SValentin Clement static mlir::Value 21558c22cb84SValentin Clement genDataTransferStmt(Fortran::lower::AbstractConverter &converter, 21568c22cb84SValentin Clement const A &stmt) { 21578c22cb84SValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 21588c22cb84SValentin Clement Fortran::lower::StatementContext stmtCtx; 21598c22cb84SValentin Clement mlir::Location loc = converter.getCurrentLocation(); 21608c22cb84SValentin Clement const bool isFormatted = isDataTransferFormatted(stmt); 21618c22cb84SValentin Clement const bool isList = isFormatted ? isDataTransferList(stmt) : false; 21628c22cb84SValentin Clement const bool isInternal = isDataTransferInternal(stmt); 2163c0921586SKazu Hirata std::optional<fir::ExtendedValue> descRef = 2164a02f7505SValentin Clement isInternal ? maybeGetInternalIODescriptor(converter, loc, stmt, stmtCtx) 21659a417395SKazu Hirata : std::nullopt; 21660916d96dSKazu Hirata const bool isInternalWithDesc = descRef.has_value(); 21678c22cb84SValentin Clement const bool isNml = isDataTransferNamelist(stmt); 21684679132aSjeanPerier // Flang runtime currently implement asynchronous IO synchronously, so 21694679132aSjeanPerier // asynchronous IO statements are lowered as regular IO statements 21704679132aSjeanPerier // (except that GetAsynchronousId may be called to set the ID variable 21714679132aSjeanPerier // and SetAsynchronous will be call to tell the runtime that this is supposed 21724679132aSjeanPerier // to be (or not) an asynchronous IO statements). 21738c22cb84SValentin Clement 21741bffc753SEric Schweitz // Generate an EnableHandlers call and remaining specifier calls. 21751bffc753SEric Schweitz ConditionSpecInfo csi; 21761bffc753SEric Schweitz if constexpr (hasIOCtrl) { 21771bffc753SEric Schweitz csi = lowerErrorSpec(converter, loc, stmt.controls); 21781bffc753SEric Schweitz } 21791bffc753SEric Schweitz 21808c22cb84SValentin Clement // Generate the begin data transfer function call. 21811c7889caSValentin Clement mlir::func::FuncOp ioFunc = getBeginDataTransferFunc<isInput>( 21821c7889caSValentin Clement loc, builder, isFormatted, isList || isNml, isInternal, 21834679132aSjeanPerier isInternalWithDesc); 21848c22cb84SValentin Clement llvm::SmallVector<mlir::Value> ioArgs; 21858f3357b7SPeter Klausler genBeginDataTransferCallArgs< 21868f3357b7SPeter Klausler hasIOCtrl, isInput ? Fortran::runtime::io::DefaultInputUnit 21878f3357b7SPeter Klausler : Fortran::runtime::io::DefaultOutputUnit>( 21884a3460a7SRiver Riddle ioArgs, converter, loc, stmt, ioFunc.getFunctionType(), isFormatted, 21894679132aSjeanPerier isList || isNml, isInternal, descRef, csi, stmtCtx); 21908c22cb84SValentin Clement mlir::Value cookie = 21918c22cb84SValentin Clement builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 21928c22cb84SValentin Clement 21938c22cb84SValentin Clement auto insertPt = builder.saveInsertionPoint(); 21948c22cb84SValentin Clement mlir::Value ok; 21958c22cb84SValentin Clement if constexpr (hasIOCtrl) { 21968c22cb84SValentin Clement genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi); 21978c22cb84SValentin Clement threadSpecs(converter, loc, cookie, stmt.controls, 21988c22cb84SValentin Clement csi.hasErrorConditionSpec(), ok); 21998c22cb84SValentin Clement } 22008c22cb84SValentin Clement 22018c22cb84SValentin Clement // Generate data transfer list calls. 22028c22cb84SValentin Clement if constexpr (isInput) { // READ 22038c22cb84SValentin Clement if (isNml) 22048c22cb84SValentin Clement genNamelistIO(converter, cookie, 22058c22cb84SValentin Clement getIORuntimeFunc<mkIOKey(InputNamelist)>(loc, builder), 22068c22cb84SValentin Clement *getIOControl<Fortran::parser::Name>(stmt)->symbol, 22078c22cb84SValentin Clement csi.hasTransferConditionSpec(), ok, stmtCtx); 22088c22cb84SValentin Clement else 22098c22cb84SValentin Clement genInputItemList(converter, cookie, stmt.items, isFormatted, 22101bffc753SEric Schweitz csi.hasTransferConditionSpec(), ok, /*inLoop=*/false); 22118c22cb84SValentin Clement } else if constexpr (std::is_same_v<A, Fortran::parser::WriteStmt>) { 22128c22cb84SValentin Clement if (isNml) 22138c22cb84SValentin Clement genNamelistIO(converter, cookie, 22148c22cb84SValentin Clement getIORuntimeFunc<mkIOKey(OutputNamelist)>(loc, builder), 22158c22cb84SValentin Clement *getIOControl<Fortran::parser::Name>(stmt)->symbol, 22168c22cb84SValentin Clement csi.hasTransferConditionSpec(), ok, stmtCtx); 22178c22cb84SValentin Clement else 22188c22cb84SValentin Clement genOutputItemList(converter, cookie, stmt.items, isFormatted, 22198c22cb84SValentin Clement csi.hasTransferConditionSpec(), ok, 22201bffc753SEric Schweitz /*inLoop=*/false); 22218c22cb84SValentin Clement } else { // PRINT 22228c22cb84SValentin Clement genOutputItemList(converter, cookie, std::get<1>(stmt.t), isFormatted, 22238c22cb84SValentin Clement csi.hasTransferConditionSpec(), ok, 22241bffc753SEric Schweitz /*inLoop=*/false); 22258c22cb84SValentin Clement } 22268c22cb84SValentin Clement 22278c22cb84SValentin Clement builder.restoreInsertionPoint(insertPt); 22288c22cb84SValentin Clement if constexpr (hasIOCtrl) { 22294679132aSjeanPerier for (const auto &spec : stmt.controls) 22304679132aSjeanPerier if (const auto *size = 22314679132aSjeanPerier std::get_if<Fortran::parser::IoControlSpec::Size>(&spec.u)) { 22324679132aSjeanPerier // This call is not conditional on the current IO status (ok) because 22334679132aSjeanPerier // the size needs to be filled even if some error condition 22344679132aSjeanPerier // (end-of-file...) was met during the input statement (in which case 22354679132aSjeanPerier // the runtime may return zero for the size read). 22364679132aSjeanPerier genIOGetVar<mkIOKey(GetSize)>(converter, loc, cookie, *size); 22374679132aSjeanPerier } else if (const auto *idVar = 22384679132aSjeanPerier std::get_if<Fortran::parser::IdVariable>(&spec.u)) { 22394679132aSjeanPerier genIOGetVar<mkIOKey(GetAsynchronousId)>(converter, loc, cookie, *idVar); 22404679132aSjeanPerier } 22418c22cb84SValentin Clement } 22428c22cb84SValentin Clement // Generate end statement call/s. 224376fd4bf6SPeter Steinfeld mlir::Value result = genEndIO(converter, loc, cookie, csi, stmtCtx); 22442c143345SV Donaldson stmtCtx.finalizeAndReset(); 224576fd4bf6SPeter Steinfeld return result; 22468c22cb84SValentin Clement } 22478c22cb84SValentin Clement 22488c22cb84SValentin Clement void Fortran::lower::genPrintStatement( 22498c22cb84SValentin Clement Fortran::lower::AbstractConverter &converter, 22508c22cb84SValentin Clement const Fortran::parser::PrintStmt &stmt) { 22518c22cb84SValentin Clement // PRINT does not take an io-control-spec. It only has a format specifier, so 22528c22cb84SValentin Clement // it is a simplified case of WRITE. 22538c22cb84SValentin Clement genDataTransferStmt</*isInput=*/false, /*ioCtrl=*/false>(converter, stmt); 22548c22cb84SValentin Clement } 22558c22cb84SValentin Clement 22568c22cb84SValentin Clement mlir::Value 22578c22cb84SValentin Clement Fortran::lower::genWriteStatement(Fortran::lower::AbstractConverter &converter, 22588c22cb84SValentin Clement const Fortran::parser::WriteStmt &stmt) { 22598c22cb84SValentin Clement return genDataTransferStmt</*isInput=*/false>(converter, stmt); 22608c22cb84SValentin Clement } 22618c22cb84SValentin Clement 22628c22cb84SValentin Clement mlir::Value 22638c22cb84SValentin Clement Fortran::lower::genReadStatement(Fortran::lower::AbstractConverter &converter, 22648c22cb84SValentin Clement const Fortran::parser::ReadStmt &stmt) { 22658c22cb84SValentin Clement return genDataTransferStmt</*isInput=*/true>(converter, stmt); 22668c22cb84SValentin Clement } 22677e32cadaSValentin Clement 22687e32cadaSValentin Clement /// Get the file expression from the inquire spec list. Also return if the 22697e32cadaSValentin Clement /// expression is a file name. 22707e32cadaSValentin Clement static std::pair<const Fortran::lower::SomeExpr *, bool> 22717e32cadaSValentin Clement getInquireFileExpr(const std::list<Fortran::parser::InquireSpec> *stmt) { 22727e32cadaSValentin Clement if (!stmt) 22737e32cadaSValentin Clement return {nullptr, /*filename?=*/false}; 22747e32cadaSValentin Clement for (const Fortran::parser::InquireSpec &spec : *stmt) { 22757e32cadaSValentin Clement if (auto *f = std::get_if<Fortran::parser::FileUnitNumber>(&spec.u)) 22767e32cadaSValentin Clement return {Fortran::semantics::GetExpr(*f), /*filename?=*/false}; 22777e32cadaSValentin Clement if (auto *f = std::get_if<Fortran::parser::FileNameExpr>(&spec.u)) 22787e32cadaSValentin Clement return {Fortran::semantics::GetExpr(*f), /*filename?=*/true}; 22797e32cadaSValentin Clement } 22807e32cadaSValentin Clement // semantics should have already caught this condition 22817e32cadaSValentin Clement llvm::report_fatal_error("inquire spec must have a file"); 22827e32cadaSValentin Clement } 22837e32cadaSValentin Clement 22847e32cadaSValentin Clement /// Generate calls to the four distinct INQUIRE subhandlers. An INQUIRE may 22857e32cadaSValentin Clement /// return values of type CHARACTER, INTEGER, or LOGICAL. There is one 22867e32cadaSValentin Clement /// additional special case for INQUIRE with both PENDING and ID specifiers. 22877e32cadaSValentin Clement template <typename A> 22887e32cadaSValentin Clement static mlir::Value genInquireSpec(Fortran::lower::AbstractConverter &converter, 22897e32cadaSValentin Clement mlir::Location loc, mlir::Value cookie, 22907e32cadaSValentin Clement mlir::Value idExpr, const A &var, 22917e32cadaSValentin Clement Fortran::lower::StatementContext &stmtCtx) { 22927e32cadaSValentin Clement // default case: do nothing 22937e32cadaSValentin Clement return {}; 22947e32cadaSValentin Clement } 22957e32cadaSValentin Clement /// Specialization for CHARACTER. 22967e32cadaSValentin Clement template <> 22977e32cadaSValentin Clement mlir::Value genInquireSpec<Fortran::parser::InquireSpec::CharVar>( 22987e32cadaSValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 22997e32cadaSValentin Clement mlir::Value cookie, mlir::Value idExpr, 23007e32cadaSValentin Clement const Fortran::parser::InquireSpec::CharVar &var, 23017e32cadaSValentin Clement Fortran::lower::StatementContext &stmtCtx) { 23027e32cadaSValentin Clement // IOMSG is handled with exception conditions 23037e32cadaSValentin Clement if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t) == 23047e32cadaSValentin Clement Fortran::parser::InquireSpec::CharVar::Kind::Iomsg) 23057e32cadaSValentin Clement return {}; 23067e32cadaSValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 23071c7889caSValentin Clement mlir::func::FuncOp specFunc = 23081c7889caSValentin Clement getIORuntimeFunc<mkIOKey(InquireCharacter)>(loc, builder); 23094a3460a7SRiver Riddle mlir::FunctionType specFuncTy = specFunc.getFunctionType(); 23107e32cadaSValentin Clement const auto *varExpr = Fortran::semantics::GetExpr( 23117e32cadaSValentin Clement std::get<Fortran::parser::ScalarDefaultCharVariable>(var.t)); 23121bffc753SEric Schweitz fir::ExtendedValue str = converter.genExprAddr(loc, varExpr, stmtCtx); 23137e32cadaSValentin Clement llvm::SmallVector<mlir::Value> args = { 23147e32cadaSValentin Clement builder.createConvert(loc, specFuncTy.getInput(0), cookie), 23157e32cadaSValentin Clement builder.createIntegerConstant( 23167e32cadaSValentin Clement loc, specFuncTy.getInput(1), 2317bcba39a5SPeter Klausler Fortran::runtime::io::HashInquiryKeyword(std::string{ 23187e32cadaSValentin Clement Fortran::parser::InquireSpec::CharVar::EnumToString( 2319bcba39a5SPeter Klausler std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t))} 23207e32cadaSValentin Clement .c_str())), 23217e32cadaSValentin Clement builder.createConvert(loc, specFuncTy.getInput(2), fir::getBase(str)), 23227e32cadaSValentin Clement builder.createConvert(loc, specFuncTy.getInput(3), fir::getLen(str))}; 23237e32cadaSValentin Clement return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0); 23247e32cadaSValentin Clement } 23257e32cadaSValentin Clement /// Specialization for INTEGER. 23267e32cadaSValentin Clement template <> 23277e32cadaSValentin Clement mlir::Value genInquireSpec<Fortran::parser::InquireSpec::IntVar>( 23287e32cadaSValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 23297e32cadaSValentin Clement mlir::Value cookie, mlir::Value idExpr, 23307e32cadaSValentin Clement const Fortran::parser::InquireSpec::IntVar &var, 23317e32cadaSValentin Clement Fortran::lower::StatementContext &stmtCtx) { 23327e32cadaSValentin Clement // IOSTAT is handled with exception conditions 23337e32cadaSValentin Clement if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) == 23347e32cadaSValentin Clement Fortran::parser::InquireSpec::IntVar::Kind::Iostat) 23357e32cadaSValentin Clement return {}; 23367e32cadaSValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 23371c7889caSValentin Clement mlir::func::FuncOp specFunc = 23381c7889caSValentin Clement getIORuntimeFunc<mkIOKey(InquireInteger64)>(loc, builder); 23394a3460a7SRiver Riddle mlir::FunctionType specFuncTy = specFunc.getFunctionType(); 23407e32cadaSValentin Clement const auto *varExpr = Fortran::semantics::GetExpr( 23417e32cadaSValentin Clement std::get<Fortran::parser::ScalarIntVariable>(var.t)); 23421bffc753SEric Schweitz mlir::Value addr = fir::getBase(converter.genExprAddr(loc, varExpr, stmtCtx)); 23437e32cadaSValentin Clement mlir::Type eleTy = fir::dyn_cast_ptrEleTy(addr.getType()); 23447e32cadaSValentin Clement if (!eleTy) 23457e32cadaSValentin Clement fir::emitFatalError(loc, 23467e32cadaSValentin Clement "internal error: expected a memory reference type"); 2347fac349a1SChristian Sigg auto width = mlir::cast<mlir::IntegerType>(eleTy).getWidth(); 23487e32cadaSValentin Clement mlir::IndexType idxTy = builder.getIndexType(); 23499aeb7f03SValentin Clement mlir::Value kind = builder.createIntegerConstant(loc, idxTy, width / 8); 23507e32cadaSValentin Clement llvm::SmallVector<mlir::Value> args = { 23517e32cadaSValentin Clement builder.createConvert(loc, specFuncTy.getInput(0), cookie), 23527e32cadaSValentin Clement builder.createIntegerConstant( 23537e32cadaSValentin Clement loc, specFuncTy.getInput(1), 2354bcba39a5SPeter Klausler Fortran::runtime::io::HashInquiryKeyword(std::string{ 23557e32cadaSValentin Clement Fortran::parser::InquireSpec::IntVar::EnumToString( 2356bcba39a5SPeter Klausler std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t))} 23577e32cadaSValentin Clement .c_str())), 23587e32cadaSValentin Clement builder.createConvert(loc, specFuncTy.getInput(2), addr), 23597e32cadaSValentin Clement builder.createConvert(loc, specFuncTy.getInput(3), kind)}; 23607e32cadaSValentin Clement return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0); 23617e32cadaSValentin Clement } 23627e32cadaSValentin Clement /// Specialization for LOGICAL and (PENDING + ID). 23637e32cadaSValentin Clement template <> 23647e32cadaSValentin Clement mlir::Value genInquireSpec<Fortran::parser::InquireSpec::LogVar>( 23657e32cadaSValentin Clement Fortran::lower::AbstractConverter &converter, mlir::Location loc, 23667e32cadaSValentin Clement mlir::Value cookie, mlir::Value idExpr, 23677e32cadaSValentin Clement const Fortran::parser::InquireSpec::LogVar &var, 23687e32cadaSValentin Clement Fortran::lower::StatementContext &stmtCtx) { 23697e32cadaSValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 23707e32cadaSValentin Clement auto logVarKind = std::get<Fortran::parser::InquireSpec::LogVar::Kind>(var.t); 23717e32cadaSValentin Clement bool pendId = 23727e32cadaSValentin Clement idExpr && 23737e32cadaSValentin Clement logVarKind == Fortran::parser::InquireSpec::LogVar::Kind::Pending; 23741c7889caSValentin Clement mlir::func::FuncOp specFunc = 23757e32cadaSValentin Clement pendId ? getIORuntimeFunc<mkIOKey(InquirePendingId)>(loc, builder) 23767e32cadaSValentin Clement : getIORuntimeFunc<mkIOKey(InquireLogical)>(loc, builder); 23774a3460a7SRiver Riddle mlir::FunctionType specFuncTy = specFunc.getFunctionType(); 23787e32cadaSValentin Clement mlir::Value addr = fir::getBase(converter.genExprAddr( 23791bffc753SEric Schweitz loc, 23807e32cadaSValentin Clement Fortran::semantics::GetExpr( 23817e32cadaSValentin Clement std::get<Fortran::parser::Scalar< 23827e32cadaSValentin Clement Fortran::parser::Logical<Fortran::parser::Variable>>>(var.t)), 23831bffc753SEric Schweitz stmtCtx)); 23847e32cadaSValentin Clement llvm::SmallVector<mlir::Value> args = { 23857e32cadaSValentin Clement builder.createConvert(loc, specFuncTy.getInput(0), cookie)}; 23867e32cadaSValentin Clement if (pendId) 23877e32cadaSValentin Clement args.push_back(builder.createConvert(loc, specFuncTy.getInput(1), idExpr)); 23887e32cadaSValentin Clement else 23897e32cadaSValentin Clement args.push_back(builder.createIntegerConstant( 23907e32cadaSValentin Clement loc, specFuncTy.getInput(1), 2391bcba39a5SPeter Klausler Fortran::runtime::io::HashInquiryKeyword(std::string{ 2392bcba39a5SPeter Klausler Fortran::parser::InquireSpec::LogVar::EnumToString(logVarKind)} 23937e32cadaSValentin Clement .c_str()))); 23947e32cadaSValentin Clement args.push_back(builder.createConvert(loc, specFuncTy.getInput(2), addr)); 23959aeb7f03SValentin Clement auto call = builder.create<fir::CallOp>(loc, specFunc, args); 23969aeb7f03SValentin Clement boolRefToLogical(loc, builder, addr); 23979aeb7f03SValentin Clement return call.getResult(0); 23987e32cadaSValentin Clement } 23997e32cadaSValentin Clement 24007e32cadaSValentin Clement /// If there is an IdExpr in the list of inquire-specs, then lower it and return 24017e32cadaSValentin Clement /// the resulting Value. Otherwise, return null. 24027e32cadaSValentin Clement static mlir::Value 24037e32cadaSValentin Clement lowerIdExpr(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 24047e32cadaSValentin Clement const std::list<Fortran::parser::InquireSpec> &ispecs, 24057e32cadaSValentin Clement Fortran::lower::StatementContext &stmtCtx) { 24067e32cadaSValentin Clement for (const Fortran::parser::InquireSpec &spec : ispecs) 240777d8cfb3SAlexander Shaposhnikov if (mlir::Value v = Fortran::common::visit( 24087e32cadaSValentin Clement Fortran::common::visitors{ 24097e32cadaSValentin Clement [&](const Fortran::parser::IdExpr &idExpr) { 24107e32cadaSValentin Clement return fir::getBase(converter.genExprValue( 24111bffc753SEric Schweitz loc, Fortran::semantics::GetExpr(idExpr), stmtCtx)); 24127e32cadaSValentin Clement }, 24137e32cadaSValentin Clement [](const auto &) { return mlir::Value{}; }}, 24147e32cadaSValentin Clement spec.u)) 24157e32cadaSValentin Clement return v; 24167e32cadaSValentin Clement return {}; 24177e32cadaSValentin Clement } 24187e32cadaSValentin Clement 24197e32cadaSValentin Clement /// For each inquire-spec, build the appropriate call, threading the cookie. 24207e32cadaSValentin Clement static void threadInquire(Fortran::lower::AbstractConverter &converter, 24217e32cadaSValentin Clement mlir::Location loc, mlir::Value cookie, 24227e32cadaSValentin Clement const std::list<Fortran::parser::InquireSpec> &ispecs, 24237e32cadaSValentin Clement bool checkResult, mlir::Value &ok, 24247e32cadaSValentin Clement Fortran::lower::StatementContext &stmtCtx) { 24257e32cadaSValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 24267e32cadaSValentin Clement mlir::Value idExpr = lowerIdExpr(converter, loc, ispecs, stmtCtx); 24277e32cadaSValentin Clement for (const Fortran::parser::InquireSpec &spec : ispecs) { 24287e32cadaSValentin Clement makeNextConditionalOn(builder, loc, checkResult, ok); 242977d8cfb3SAlexander Shaposhnikov ok = Fortran::common::visit(Fortran::common::visitors{[&](const auto &x) { 243077d8cfb3SAlexander Shaposhnikov return genInquireSpec(converter, loc, cookie, 243177d8cfb3SAlexander Shaposhnikov idExpr, x, stmtCtx); 24327e32cadaSValentin Clement }}, 24337e32cadaSValentin Clement spec.u); 24347e32cadaSValentin Clement } 24357e32cadaSValentin Clement } 24367e32cadaSValentin Clement 24377e32cadaSValentin Clement mlir::Value Fortran::lower::genInquireStatement( 24387e32cadaSValentin Clement Fortran::lower::AbstractConverter &converter, 24397e32cadaSValentin Clement const Fortran::parser::InquireStmt &stmt) { 24407e32cadaSValentin Clement fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 24417e32cadaSValentin Clement Fortran::lower::StatementContext stmtCtx; 24427e32cadaSValentin Clement mlir::Location loc = converter.getCurrentLocation(); 244358ceae95SRiver Riddle mlir::func::FuncOp beginFunc; 24447e32cadaSValentin Clement llvm::SmallVector<mlir::Value> beginArgs; 24457e32cadaSValentin Clement const auto *list = 24467e32cadaSValentin Clement std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u); 24477e32cadaSValentin Clement auto exprPair = getInquireFileExpr(list); 24487e32cadaSValentin Clement auto inquireFileUnit = [&]() -> bool { 24497e32cadaSValentin Clement return exprPair.first && !exprPair.second; 24507e32cadaSValentin Clement }; 24517e32cadaSValentin Clement auto inquireFileName = [&]() -> bool { 24527e32cadaSValentin Clement return exprPair.first && exprPair.second; 24537e32cadaSValentin Clement }; 24547e32cadaSValentin Clement 24551bffc753SEric Schweitz ConditionSpecInfo csi = 24561bffc753SEric Schweitz list ? lowerErrorSpec(converter, loc, *list) : ConditionSpecInfo{}; 24571bffc753SEric Schweitz 24587e32cadaSValentin Clement // Make one of three BeginInquire calls. 24597e32cadaSValentin Clement if (inquireFileUnit()) { 24607e32cadaSValentin Clement // Inquire by unit -- [UNIT=]file-unit-number. 24617e32cadaSValentin Clement beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireUnit)>(loc, builder); 24624a3460a7SRiver Riddle mlir::FunctionType beginFuncTy = beginFunc.getFunctionType(); 24631bffc753SEric Schweitz mlir::Value unit = genIOUnitNumber(converter, loc, exprPair.first, 24641bffc753SEric Schweitz beginFuncTy.getInput(0), csi, stmtCtx); 24651bffc753SEric Schweitz beginArgs = {unit, locToFilename(converter, loc, beginFuncTy.getInput(1)), 24667e32cadaSValentin Clement locToLineNo(converter, loc, beginFuncTy.getInput(2))}; 24677e32cadaSValentin Clement } else if (inquireFileName()) { 24687e32cadaSValentin Clement // Inquire by file -- FILE=file-name-expr. 24697e32cadaSValentin Clement beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireFile)>(loc, builder); 24704a3460a7SRiver Riddle mlir::FunctionType beginFuncTy = beginFunc.getFunctionType(); 24717e32cadaSValentin Clement fir::ExtendedValue file = 24721bffc753SEric Schweitz converter.genExprAddr(loc, exprPair.first, stmtCtx); 24737e32cadaSValentin Clement beginArgs = { 24747e32cadaSValentin Clement builder.createConvert(loc, beginFuncTy.getInput(0), fir::getBase(file)), 24757e32cadaSValentin Clement builder.createConvert(loc, beginFuncTy.getInput(1), fir::getLen(file)), 24767e32cadaSValentin Clement locToFilename(converter, loc, beginFuncTy.getInput(2)), 24777e32cadaSValentin Clement locToLineNo(converter, loc, beginFuncTy.getInput(3))}; 24787e32cadaSValentin Clement } else { 24797e32cadaSValentin Clement // Inquire by output list -- IOLENGTH=scalar-int-variable. 24807e32cadaSValentin Clement const auto *ioLength = 24817e32cadaSValentin Clement std::get_if<Fortran::parser::InquireStmt::Iolength>(&stmt.u); 24827e32cadaSValentin Clement assert(ioLength && "must have an IOLENGTH specifier"); 24837e32cadaSValentin Clement beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireIoLength)>(loc, builder); 24844a3460a7SRiver Riddle mlir::FunctionType beginFuncTy = beginFunc.getFunctionType(); 24857e32cadaSValentin Clement beginArgs = {locToFilename(converter, loc, beginFuncTy.getInput(0)), 24867e32cadaSValentin Clement locToLineNo(converter, loc, beginFuncTy.getInput(1))}; 24877e32cadaSValentin Clement auto cookie = 24887e32cadaSValentin Clement builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 24897e32cadaSValentin Clement mlir::Value ok; 24907e32cadaSValentin Clement genOutputItemList( 24917e32cadaSValentin Clement converter, cookie, 24927e32cadaSValentin Clement std::get<std::list<Fortran::parser::OutputItem>>(ioLength->t), 24931bffc753SEric Schweitz /*isFormatted=*/false, /*checkResult=*/false, ok, /*inLoop=*/false); 24947e32cadaSValentin Clement auto *ioLengthVar = Fortran::semantics::GetExpr( 24957e32cadaSValentin Clement std::get<Fortran::parser::ScalarIntVariable>(ioLength->t)); 24967e32cadaSValentin Clement mlir::Value ioLengthVarAddr = 24971bffc753SEric Schweitz fir::getBase(converter.genExprAddr(loc, ioLengthVar, stmtCtx)); 24987e32cadaSValentin Clement llvm::SmallVector<mlir::Value> args = {cookie}; 24997e32cadaSValentin Clement mlir::Value length = 25007e32cadaSValentin Clement builder 25017e32cadaSValentin Clement .create<fir::CallOp>( 25027e32cadaSValentin Clement loc, getIORuntimeFunc<mkIOKey(GetIoLength)>(loc, builder), args) 25037e32cadaSValentin Clement .getResult(0); 25047e32cadaSValentin Clement mlir::Value length1 = 25057e32cadaSValentin Clement builder.createConvert(loc, converter.genType(*ioLengthVar), length); 25067e32cadaSValentin Clement builder.create<fir::StoreOp>(loc, length1, ioLengthVarAddr); 25077e32cadaSValentin Clement return genEndIO(converter, loc, cookie, csi, stmtCtx); 25087e32cadaSValentin Clement } 25097e32cadaSValentin Clement 25107e32cadaSValentin Clement // Common handling for inquire by unit or file. 25117e32cadaSValentin Clement assert(list && "inquire-spec list must be present"); 25127e32cadaSValentin Clement auto cookie = 25137e32cadaSValentin Clement builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 25147e32cadaSValentin Clement genConditionHandlerCall(converter, loc, cookie, *list, csi); 25157e32cadaSValentin Clement // Handle remaining arguments in specifier list. 25167e32cadaSValentin Clement mlir::Value ok; 25177e32cadaSValentin Clement auto insertPt = builder.saveInsertionPoint(); 25187e32cadaSValentin Clement threadInquire(converter, loc, cookie, *list, csi.hasErrorConditionSpec(), ok, 25197e32cadaSValentin Clement stmtCtx); 25207e32cadaSValentin Clement builder.restoreInsertionPoint(insertPt); 25217e32cadaSValentin Clement // Generate end statement call. 25227e32cadaSValentin Clement return genEndIO(converter, loc, cookie, csi, stmtCtx); 25237e32cadaSValentin Clement } 2524