xref: /llvm-project/flang/lib/Lower/IO.cpp (revision 3e13acfbf4c93067d5ee5dc1f6e0c6e0fef9297f)
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