diff --git a/flang/include/flang/Lower/IO.h b/flang/include/flang/Lower/IO.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/IO.h @@ -0,0 +1,98 @@ +//===-- Lower/IO.h -- lower I/O statements ----------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_IO_H +#define FORTRAN_LOWER_IO_H + +#include "flang/Common/reference.h" +#include "flang/Semantics/symbol.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/SmallSet.h" + +namespace mlir { +class Value; +} // namespace mlir + +namespace Fortran { +namespace parser { +using Label = std::uint64_t; +struct BackspaceStmt; +struct CloseStmt; +struct EndfileStmt; +struct FlushStmt; +struct InquireStmt; +struct OpenStmt; +struct PrintStmt; +struct ReadStmt; +struct RewindStmt; +struct WaitStmt; +struct WriteStmt; +} // namespace parser + +namespace lower { + +class AbstractConverter; +class BridgeImpl; + +namespace pft { +struct Evaluation; +using LabelEvalMap = llvm::DenseMap; +using SymbolRef = Fortran::common::Reference; +using LabelSet = llvm::SmallSet; +using SymbolLabelMap = llvm::DenseMap; +} // namespace pft + +/// Generate IO call(s) for BACKSPACE; return the IOSTAT code +mlir::Value genBackspaceStatement(AbstractConverter &, + const parser::BackspaceStmt &); + +/// Generate IO call(s) for CLOSE; return the IOSTAT code +mlir::Value genCloseStatement(AbstractConverter &, const parser::CloseStmt &); + +/// Generate IO call(s) for ENDFILE; return the IOSTAT code +mlir::Value genEndfileStatement(AbstractConverter &, + const parser::EndfileStmt &); + +/// Generate IO call(s) for FLUSH; return the IOSTAT code +mlir::Value genFlushStatement(AbstractConverter &, const parser::FlushStmt &); + +/// Generate IO call(s) for INQUIRE; return the IOSTAT code +mlir::Value genInquireStatement(AbstractConverter &, + const parser::InquireStmt &); + +/// Generate IO call(s) for OPEN; return the IOSTAT code +mlir::Value genOpenStatement(AbstractConverter &, const parser::OpenStmt &); + +/// Generate IO call(s) for PRINT +void genPrintStatement(AbstractConverter &converter, + const parser::PrintStmt &stmt, + pft::LabelEvalMap &labelMap, + pft::SymbolLabelMap &assignMap); + +/// Generate IO call(s) for READ; return the IOSTAT code +mlir::Value genReadStatement(AbstractConverter &converter, + const parser::ReadStmt &stmt, + pft::LabelEvalMap &labelMap, + pft::SymbolLabelMap &assignMap); + +/// Generate IO call(s) for REWIND; return the IOSTAT code +mlir::Value genRewindStatement(AbstractConverter &, const parser::RewindStmt &); + +/// Generate IO call(s) for WAIT; return the IOSTAT code +mlir::Value genWaitStatement(AbstractConverter &, const parser::WaitStmt &); + +/// Generate IO call(s) for WRITE; return the IOSTAT code +mlir::Value genWriteStatement(AbstractConverter &converter, + const parser::WriteStmt &stmt, + pft::LabelEvalMap &labelMap, + pft::SymbolLabelMap &assignMap); + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_IO_H diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -9,6 +9,7 @@ ConvertType.cpp DoLoopHelper.cpp FIRBuilder.cpp + IO.cpp Mangler.cpp OpenMP.cpp PFTBuilder.cpp diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/IO.cpp @@ -0,0 +1,1493 @@ +//===-- IO.cpp -- I/O statement lowering ----------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/IO.h" +#include "../../runtime/io-api.h" +#include "RTBuilder.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/CharacterExpr.h" +#include "flang/Lower/ComplexExpr.h" +#include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Runtime.h" +#include "flang/Lower/Utils.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/tools.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" + +#define TODO() llvm_unreachable("not yet implemented") + +using namespace Fortran::runtime::io; + +#define NAMIFY_HELPER(X) #X +#define NAMIFY(X) NAMIFY_HELPER(IONAME(X)) +#define mkIOKey(X) mkKey(IONAME(X)) + +namespace Fortran::lower { +/// Static table of IO runtime calls +/// +/// This logical map contains the name and type builder function for each IO +/// runtime function listed in the tuple. This table is fully constructed at +/// compile-time. Use the `mkIOKey` macro to access the table. +static constexpr std::tuple< + mkIOKey(BeginInternalArrayListOutput), mkIOKey(BeginInternalArrayListInput), + mkIOKey(BeginInternalArrayFormattedOutput), + mkIOKey(BeginInternalArrayFormattedInput), mkIOKey(BeginInternalListOutput), + mkIOKey(BeginInternalListInput), mkIOKey(BeginInternalFormattedOutput), + mkIOKey(BeginInternalFormattedInput), mkIOKey(BeginInternalNamelistOutput), + mkIOKey(BeginInternalNamelistInput), mkIOKey(BeginExternalListOutput), + mkIOKey(BeginExternalListInput), mkIOKey(BeginExternalFormattedOutput), + mkIOKey(BeginExternalFormattedInput), mkIOKey(BeginUnformattedOutput), + mkIOKey(BeginUnformattedInput), mkIOKey(BeginExternalNamelistOutput), + mkIOKey(BeginExternalNamelistInput), mkIOKey(BeginAsynchronousOutput), + mkIOKey(BeginAsynchronousInput), mkIOKey(BeginWait), mkIOKey(BeginWaitAll), + mkIOKey(BeginClose), mkIOKey(BeginFlush), mkIOKey(BeginBackspace), + mkIOKey(BeginEndfile), mkIOKey(BeginRewind), mkIOKey(BeginOpenUnit), + mkIOKey(BeginOpenNewUnit), mkIOKey(BeginInquireUnit), + mkIOKey(BeginInquireFile), mkIOKey(BeginInquireIoLength), + mkIOKey(EnableHandlers), mkIOKey(SetAdvance), mkIOKey(SetBlank), + mkIOKey(SetDecimal), mkIOKey(SetDelim), mkIOKey(SetPad), mkIOKey(SetPos), + mkIOKey(SetRec), mkIOKey(SetRound), mkIOKey(SetSign), + mkIOKey(OutputDescriptor), mkIOKey(InputDescriptor), + mkIOKey(OutputUnformattedBlock), mkIOKey(InputUnformattedBlock), + mkIOKey(OutputInteger64), mkIOKey(InputInteger), mkIOKey(OutputReal32), + mkIOKey(InputReal32), mkIOKey(OutputReal64), mkIOKey(InputReal64), + mkIOKey(OutputComplex64), mkIOKey(OutputComplex32), mkIOKey(OutputAscii), + mkIOKey(InputAscii), mkIOKey(OutputLogical), mkIOKey(InputLogical), + mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAsynchronous), + mkIOKey(SetEncoding), mkIOKey(SetForm), mkIOKey(SetPosition), + mkIOKey(SetRecl), mkIOKey(SetStatus), mkIOKey(SetFile), mkIOKey(GetNewUnit), + mkIOKey(GetSize), mkIOKey(GetIoLength), mkIOKey(GetIoMsg), + mkIOKey(InquireCharacter), mkIOKey(InquireLogical), + mkIOKey(InquirePendingId), mkIOKey(InquireInteger64), + mkIOKey(EndIoStatement)> + newIOTable; +} // namespace Fortran::lower + +namespace { +struct ConditionSpecifierInfo { + const Fortran::semantics::SomeExpr *ioStatExpr{}; + const Fortran::semantics::SomeExpr *ioMsgExpr{}; + bool hasErr{}; + bool hasEnd{}; + bool hasEor{}; + + /// Check for any condition specifier that applies to specifier processing. + bool hasErrorConditionSpecifier() const { + return ioStatExpr != nullptr || hasErr; + } + /// Check for any condition specifier that applies to data transfer items + /// in a PRINT, READ, WRITE, or WAIT statement. (WAIT may be irrelevant.) + bool hasTransferConditionSpecifier() const { + return ioStatExpr != nullptr || hasErr || hasEnd || hasEor; + } + /// Check for any condition specifier, including IOMSG. + bool hasAnyConditionSpecifier() const { + return ioStatExpr != nullptr || ioMsgExpr != nullptr || hasErr || hasEnd || + hasEor; + } +}; +} // namespace + +using namespace Fortran::lower; + +/// Helper function to retrieve the name of the IO function given the key `A` +template +static constexpr const char *getName() { + return std::get(newIOTable).name; +} + +/// Helper function to retrieve the type model signature builder of the IO +/// function as defined by the key `A` +template +static constexpr FuncTypeBuilderFunc getTypeModel() { + return std::get(newIOTable).getTypeModel(); +} + +inline int64_t getLength(mlir::Type argTy) { + return argTy.cast().getShape()[0]; +} + +/// Get (or generate) the MLIR FuncOp for a given IO runtime function. +template +static mlir::FuncOp getIORuntimeFunc(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder) { + auto name = getName(); + auto func = builder.getNamedFunction(name); + if (func) + return func; + auto funTy = getTypeModel()(builder.getContext()); + func = builder.createFunction(loc, name, funTy); + func.setAttr("fir.runtime", builder.getUnitAttr()); + func.setAttr("fir.io", builder.getUnitAttr()); + return func; +} + +/// Generate calls to end an IO statement. Return the IOSTAT value, if any. +/// It is the caller's responsibility to generate branches on that value. +static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Value cookie, + const ConditionSpecifierInfo &csi) { + auto &builder = converter.getFirOpBuilder(); + if (csi.ioMsgExpr) { + auto getIoMsg = getIORuntimeFunc(loc, builder); + auto ioMsgVar = + Fortran::lower::CharacterExprHelper{builder, loc}.createUnboxChar( + converter.genExprAddr(csi.ioMsgExpr, loc)); + llvm::SmallVector args{ + cookie, + builder.createConvert(loc, getIoMsg.getType().getInput(1), + ioMsgVar.first), + builder.createConvert(loc, getIoMsg.getType().getInput(2), + ioMsgVar.second)}; + builder.create(loc, getIoMsg, args); + } + auto endIoStatement = getIORuntimeFunc(loc, builder); + llvm::SmallVector endArgs{cookie}; + auto call = builder.create(loc, endIoStatement, endArgs); + if (csi.ioStatExpr) { + auto ioStatVar = converter.genExprAddr(csi.ioStatExpr, loc); + auto ioStatResult = builder.createConvert( + loc, converter.genType(*csi.ioStatExpr), call.getResult(0)); + builder.create(loc, ioStatResult, ioStatVar); + } + return csi.hasTransferConditionSpecifier() ? call.getResult(0) + : mlir::Value{}; +} + +/// Make the next call in the IO statement conditional on runtime result `ok`. +/// If a call returns `ok==false`, further suboperation calls for an I/O +/// statement will be skipped. This may generate branch heavy, deeply nested +/// conditionals for I/O statements with a large number of suboperations. +static void makeNextConditionalOn(Fortran::lower::FirOpBuilder &builder, + mlir::Location loc, + mlir::OpBuilder::InsertPoint &insertPt, + bool checkResult, mlir::Value ok, + bool inIterWhileLoop = false) { + if (!checkResult || !ok) + // Either I/O calls do not need to be checked, or the next I/O call is the + // first potentially fallable call. + return; + // A previous I/O call for a statement returned the bool `ok`. If this call + // is in a fir.iterate_while loop, the result must be propagated up to the + // loop scope. That is done in genIoLoop, but it is enabled here. + auto whereOp = + inIterWhileLoop + ? builder.create(loc, builder.getI1Type(), ok, true) + : builder.create(loc, ok, /*withOtherwise=*/false); + if (!insertPt.isSet()) + insertPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(&whereOp.whereRegion().front()); +} + +template +static void genIoLoop(Fortran::lower::AbstractConverter &converter, + mlir::Value cookie, const D &ioImpliedDo, + bool checkResult, mlir::Value &ok, bool inIterWhileLoop); + +/// Get the OutputXyz routine to output a value of the given type. +static mlir::FuncOp getOutputFunc(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder, + mlir::Type type) { + if (auto ty = type.dyn_cast()) + return ty.getWidth() == 1 + ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); + if (auto ty = type.dyn_cast()) + return ty.getWidth() <= 32 + ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); + if (auto ty = type.dyn_cast()) + return ty.getFKind() <= 4 + ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); + if (type.isa()) + return getIORuntimeFunc(loc, builder); + if (type.isa()) + return getIORuntimeFunc(loc, builder); + if (Fortran::lower::CharacterExprHelper::isCharacter(type)) + return getIORuntimeFunc(loc, builder); + // TODO: handle arrays + mlir::emitError(loc, "output for entity type ") << type << " not implemented"; + return {}; +} + +/// Generate a sequence of output data transfer calls. +static void +genOutputItemList(Fortran::lower::AbstractConverter &converter, + mlir::Value cookie, + const std::list &items, + mlir::OpBuilder::InsertPoint &insertPt, bool checkResult, + mlir::Value &ok, bool inIterWhileLoop) { + auto &builder = converter.getFirOpBuilder(); + for (auto &item : items) { + if (const auto &impliedDo = std::get_if<1>(&item.u)) { + genIoLoop(converter, cookie, impliedDo->value(), checkResult, ok, + inIterWhileLoop); + continue; + } + auto &pExpr = std::get(item.u); + auto loc = converter.genLocation(pExpr.source); + makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, + inIterWhileLoop); + auto itemValue = + converter.genExprValue(Fortran::semantics::GetExpr(pExpr), loc); + auto itemType = itemValue.getType(); + auto outputFunc = getOutputFunc(loc, builder, itemType); + auto argType = outputFunc.getType().getInput(1); + llvm::SmallVector outputFuncArgs = {cookie}; + Fortran::lower::CharacterExprHelper helper{builder, loc}; + if (helper.isCharacter(itemType)) { + auto dataLen = helper.materializeCharacter(itemValue); + outputFuncArgs.push_back(builder.createConvert( + loc, outputFunc.getType().getInput(1), dataLen.first)); + outputFuncArgs.push_back(builder.createConvert( + loc, outputFunc.getType().getInput(2), dataLen.second)); + } else if (fir::isa_complex(itemType)) { + auto parts = Fortran::lower::ComplexExprHelper{builder, loc}.extractParts( + itemValue); + outputFuncArgs.push_back(parts.first); + outputFuncArgs.push_back(parts.second); + } else { + itemValue = builder.createConvert(loc, argType, itemValue); + outputFuncArgs.push_back(itemValue); + } + ok = builder.create(loc, outputFunc, outputFuncArgs) + .getResult(0); + } +} + +/// Get the InputXyz routine to input a value of the given type. +static mlir::FuncOp getInputFunc(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder, + mlir::Type type) { + if (auto ty = type.dyn_cast()) + return ty.getWidth() == 1 + ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); + if (auto ty = type.dyn_cast()) + return ty.getWidth() <= 32 + ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); + if (auto ty = type.dyn_cast()) + return ty.getFKind() <= 4 + ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); + if (type.isa()) + return getIORuntimeFunc(loc, builder); + if (type.isa()) + return getIORuntimeFunc(loc, builder); + if (Fortran::lower::CharacterExprHelper::isCharacter(type)) + return getIORuntimeFunc(loc, builder); + // TODO: handle arrays + mlir::emitError(loc, "input for entity type ") << type << " not implemented"; + return {}; +} + +/// Generate a sequence of input data transfer calls. +static void genInputItemList(Fortran::lower::AbstractConverter &converter, + mlir::Value cookie, + const std::list &items, + mlir::OpBuilder::InsertPoint &insertPt, + bool checkResult, mlir::Value &ok, + bool inIterWhileLoop) { + auto &builder = converter.getFirOpBuilder(); + for (auto &item : items) { + if (const auto &impliedDo = std::get_if<1>(&item.u)) { + genIoLoop(converter, cookie, impliedDo->value(), checkResult, ok, + inIterWhileLoop); + continue; + } + auto &pVar = std::get(item.u); + auto loc = converter.genLocation(pVar.GetSource()); + makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, + inIterWhileLoop); + auto itemAddr = + converter.genExprAddr(Fortran::semantics::GetExpr(pVar), loc); + auto itemType = itemAddr.getType().cast().getEleTy(); + auto inputFunc = getInputFunc(loc, builder, itemType); + auto argType = inputFunc.getType().getInput(1); + auto originalItemAddr = itemAddr; + mlir::Type complexPartType; + if (itemType.isa()) + complexPartType = builder.getRefType( + Fortran::lower::ComplexExprHelper{builder, loc}.getComplexPartType( + itemType)); + auto complexPartAddr = [&](int index) { + return builder.create( + loc, complexPartType, originalItemAddr, + llvm::SmallVector{builder.create( + loc, builder.getI32IntegerAttr(index))}); + }; + if (complexPartType) + itemAddr = complexPartAddr(0); // real part + itemAddr = builder.createConvert(loc, argType, itemAddr); + llvm::SmallVector inputFuncArgs = {cookie, itemAddr}; + Fortran::lower::CharacterExprHelper helper{builder, loc}; + if (helper.isCharacter(itemType)) { + auto len = helper.materializeCharacter(originalItemAddr).second; + inputFuncArgs.push_back( + builder.createConvert(loc, inputFunc.getType().getInput(2), len)); + } else if (itemType.isa()) { + inputFuncArgs.push_back(builder.create( + loc, builder.getI32IntegerAttr( + itemType.cast().getWidth() / 8))); + } + ok = builder.create(loc, inputFunc, inputFuncArgs) + .getResult(0); + if (complexPartType) { // imaginary part + makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, + inIterWhileLoop); + inputFuncArgs = {cookie, + builder.createConvert(loc, argType, complexPartAddr(1))}; + ok = builder.create(loc, inputFunc, inputFuncArgs) + .getResult(0); + } + } +} + +/// Generate an io-implied-do loop. +template +static void genIoLoop(Fortran::lower::AbstractConverter &converter, + mlir::Value cookie, const D &ioImpliedDo, + bool checkResult, mlir::Value &ok, bool inIterWhileLoop) { + mlir::OpBuilder::InsertPoint insertPt; + auto &builder = converter.getFirOpBuilder(); + auto loc = converter.getCurrentLocation(); + makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, + inIterWhileLoop); + auto parentInsertPt = builder.saveInsertionPoint(); + const auto &itemList = std::get<0>(ioImpliedDo.t); + const auto &control = std::get<1>(ioImpliedDo.t); + const auto &loopSym = *control.name.thing.thing.symbol; + auto loopVar = converter.getSymbolAddress(loopSym); + auto genFIRLoopIndex = [&](const Fortran::parser::ScalarIntExpr &expr) { + return builder.createConvert( + loc, builder.getIndexType(), + converter.genExprValue(*Fortran::semantics::GetExpr(expr))); + }; + auto lowerValue = genFIRLoopIndex(control.lower); + auto upperValue = genFIRLoopIndex(control.upper); + auto stepValue = control.step.has_value() + ? genFIRLoopIndex(*control.step) + : builder.create(loc, 1); + auto genItemList = [&](const D &ioImpliedDo, bool inIterWhileLoop) { + if constexpr (std::is_same_v) + genInputItemList(converter, cookie, itemList, insertPt, checkResult, ok, + true); + else + genOutputItemList(converter, cookie, itemList, insertPt, checkResult, ok, + true); + }; + if (!checkResult) { + // No I/O call result checks - the loop is a fir.do_loop op. + auto loopOp = + builder.create(loc, lowerValue, upperValue, stepValue); + builder.setInsertionPointToStart(loopOp.getBody()); + auto lcv = builder.createConvert(loc, converter.genType(loopSym), + loopOp.getInductionVar()); + builder.create(loc, lcv, loopVar); + insertPt = builder.saveInsertionPoint(); + genItemList(ioImpliedDo, false); + builder.restoreInsertionPoint(parentInsertPt); + return; + } + // Check I/O call results - the loop is a fir.iterate_while op. + if (!ok) + ok = builder.createIntegerConstant(loc, builder.getI1Type(), 1); + fir::IterWhileOp iterWhileOp = builder.create( + loc, lowerValue, upperValue, stepValue, ok); + builder.setInsertionPointToStart(iterWhileOp.getBody()); + auto lcv = builder.createConvert(loc, converter.genType(loopSym), + iterWhileOp.getInductionVar()); + builder.create(loc, lcv, loopVar); + insertPt = builder.saveInsertionPoint(); + ok = iterWhileOp.getIterateVar(); + auto falseValue = builder.createIntegerConstant(loc, builder.getI1Type(), 0); + genItemList(ioImpliedDo, true); + // Unwind nested I/O call scopes, filling in true and false ResultOp's. + for (auto *op = builder.getBlock()->getParentOp(); isa(op); + op = op->getBlock()->getParentOp()) { + auto whereOp = dyn_cast(op); + auto *lastOp = &whereOp.whereRegion().front().back(); + builder.setInsertionPointAfter(lastOp); + builder.create(loc, lastOp->getResult(0)); // runtime result + builder.setInsertionPointToStart(&whereOp.otherRegion().front()); + builder.create(loc, falseValue); // known false result + } + builder.restoreInsertionPoint(insertPt); + builder.create(loc, builder.getBlock()->back().getResult(0)); + ok = iterWhileOp.getResult(0); + builder.restoreInsertionPoint(parentInsertPt); +} + +//===----------------------------------------------------------------------===// +// Default argument generation. +//===----------------------------------------------------------------------===// + +static mlir::Value getDefaultFilename(Fortran::lower::FirOpBuilder &builder, + mlir::Location loc, mlir::Type toType) { + mlir::Value null = + builder.create(loc, builder.getI64IntegerAttr(0)); + return builder.createConvert(loc, toType, null); +} + +static mlir::Value getDefaultLineNo(Fortran::lower::FirOpBuilder &builder, + mlir::Location loc, mlir::Type toType) { + return builder.create(loc, + builder.getIntegerAttr(toType, 0)); +} + +static mlir::Value getDefaultScratch(Fortran::lower::FirOpBuilder &builder, + mlir::Location loc, mlir::Type toType) { + mlir::Value null = + builder.create(loc, builder.getI64IntegerAttr(0)); + return builder.createConvert(loc, toType, null); +} + +static mlir::Value getDefaultScratchLen(Fortran::lower::FirOpBuilder &builder, + mlir::Location loc, mlir::Type toType) { + return builder.create(loc, + builder.getIntegerAttr(toType, 0)); +} + +/// Lower a string literal. Many arguments to the runtime are conveyed as +/// Fortran CHARACTER literals. +template +static std::tuple +lowerStringLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const A &syntax, mlir::Type strTy, mlir::Type lenTy, + mlir::Type ty2 = {}) { + auto &builder = converter.getFirOpBuilder(); + auto *expr = Fortran::semantics::GetExpr(syntax); + auto str = converter.genExprValue(expr, loc); + Fortran::lower::CharacterExprHelper helper{builder, loc}; + auto dataLen = helper.materializeCharacter(str); + auto buff = builder.createConvert(loc, strTy, dataLen.first); + auto len = builder.createConvert(loc, lenTy, dataLen.second); + if (ty2) { + auto kindVal = helper.getCharacterKind(str.getType()); + auto kind = builder.create( + loc, builder.getIntegerAttr(ty2, kindVal)); + return {buff, len, kind}; + } + return {buff, len, mlir::Value{}}; +} + +/// Pass the body of the FORMAT statement in as if it were a CHARACTER literal +/// constant. NB: This is the prescribed manner in which the front-end passes +/// this information to lowering. +static std::tuple +lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, llvm::StringRef text, + mlir::Type strTy, mlir::Type lenTy) { + text = text.drop_front(text.find('(')); + text = text.take_front(text.rfind(')') + 1); + auto &builder = converter.getFirOpBuilder(); + auto lit = builder.createStringLit( + loc, /*FIXME*/ fir::CharacterType::get(builder.getContext(), 1), text); + auto data = + Fortran::lower::CharacterExprHelper{builder, loc}.materializeCharacter( + lit); + auto buff = builder.createConvert(loc, strTy, data.first); + auto len = builder.createConvert(loc, lenTy, data.second); + return {buff, len, mlir::Value{}}; +} + +//===----------------------------------------------------------------------===// +// Handle I/O statement specifiers. +// These are threaded together for a single statement via the passed cookie. +//===----------------------------------------------------------------------===// + +/// Generic to build an integral argument to the runtime. +template +mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Value cookie, + const B &spec) { + auto &builder = converter.getFirOpBuilder(); + mlir::FuncOp ioFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType ioFuncTy = ioFunc.getType(); + auto expr = converter.genExprValue(Fortran::semantics::GetExpr(spec.v), loc); + auto val = builder.createConvert(loc, ioFuncTy.getInput(1), expr); + llvm::SmallVector ioArgs = {cookie, val}; + return builder.create(loc, ioFunc, ioArgs).getResult(0); +} + +/// Generic to build a string argument to the runtime. This passes a CHARACTER +/// as a pointer to the buffer and a LEN parameter. +template +mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Value cookie, + const B &spec) { + auto &builder = converter.getFirOpBuilder(); + mlir::FuncOp ioFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType ioFuncTy = ioFunc.getType(); + auto tup = lowerStringLit(converter, loc, spec, ioFuncTy.getInput(1), + ioFuncTy.getInput(2)); + llvm::SmallVector ioArgs = {cookie, std::get<0>(tup), + std::get<1>(tup)}; + return builder.create(loc, ioFunc, ioArgs).getResult(0); +} + +template +mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Value cookie, const A &spec) { + // default case: do nothing + return {}; +} + +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const Fortran::parser::FileNameExpr &spec) { + auto &builder = converter.getFirOpBuilder(); + // has an extra KIND argument + auto ioFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType ioFuncTy = ioFunc.getType(); + auto tup = lowerStringLit(converter, loc, spec, ioFuncTy.getInput(1), + ioFuncTy.getInput(2), ioFuncTy.getInput(3)); + llvm::SmallVector ioArgs{cookie, std::get<0>(tup), + std::get<1>(tup), std::get<2>(tup)}; + return builder.create(loc, ioFunc, ioArgs).getResult(0); +} + +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const Fortran::parser::ConnectSpec::CharExpr &spec) { + auto &builder = converter.getFirOpBuilder(); + mlir::FuncOp ioFunc; + switch (std::get(spec.t)) { + case Fortran::parser::ConnectSpec::CharExpr::Kind::Access: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Action: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Asynchronous: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Blank: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Decimal: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Delim: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Encoding: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Form: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Position: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Round: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Sign: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert: + llvm_unreachable("CONVERT not part of the runtime::io interface"); + case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose: + llvm_unreachable("DISPOSE not part of the runtime::io interface"); + } + mlir::FunctionType ioFuncTy = ioFunc.getType(); + auto tup = lowerStringLit( + converter, loc, std::get(spec.t), + ioFuncTy.getInput(1), ioFuncTy.getInput(2)); + llvm::SmallVector ioArgs = {cookie, std::get<0>(tup), + std::get<1>(tup)}; + return builder.create(loc, ioFunc, ioArgs).getResult(0); +} + +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const Fortran::parser::ConnectSpec::Recl &spec) { + return genIntIOOption(converter, loc, cookie, spec); +} + +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const Fortran::parser::StatusExpr &spec) { + return genCharIOOption(converter, loc, cookie, spec.v); +} + +template <> +mlir::Value +genIOOption(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Value cookie, + const Fortran::parser::Name &spec) { + // namelist + llvm_unreachable("not implemented"); +} + +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const Fortran::parser::IoControlSpec::CharExpr &spec) { + auto &builder = converter.getFirOpBuilder(); + mlir::FuncOp ioFunc; + switch (std::get(spec.t)) { + case Fortran::parser::IoControlSpec::CharExpr::Kind::Advance: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::IoControlSpec::CharExpr::Kind::Blank: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::IoControlSpec::CharExpr::Kind::Decimal: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::IoControlSpec::CharExpr::Kind::Round: + ioFunc = getIORuntimeFunc(loc, builder); + break; + case Fortran::parser::IoControlSpec::CharExpr::Kind::Sign: + ioFunc = getIORuntimeFunc(loc, builder); + break; + } + mlir::FunctionType ioFuncTy = ioFunc.getType(); + auto tup = lowerStringLit( + converter, loc, std::get(spec.t), + ioFuncTy.getInput(1), ioFuncTy.getInput(2)); + llvm::SmallVector ioArgs = {cookie, std::get<0>(tup), + std::get<1>(tup)}; + return builder.create(loc, ioFunc, ioArgs).getResult(0); +} + +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, + const Fortran::parser::IoControlSpec::Asynchronous &spec) { + return genCharIOOption(converter, loc, cookie, + spec.v); +} + +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const Fortran::parser::IdVariable &spec) { + llvm_unreachable("asynchronous ID not implemented"); +} + +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const Fortran::parser::IoControlSpec::Pos &spec) { + return genIntIOOption(converter, loc, cookie, spec); +} +template <> +mlir::Value genIOOption( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const Fortran::parser::IoControlSpec::Rec &spec) { + return genIntIOOption(converter, loc, cookie, spec); +} + +//===----------------------------------------------------------------------===// +// Gather I/O statement condition specifier information (if any). +//===----------------------------------------------------------------------===// + +template +static bool hasX(const A &list) { + for (const auto &spec : list) + if (std::holds_alternative(spec.u)) + return true; + return false; +} + +template +static bool hasMem(const A &stmt) { + return hasX(stmt.v); +} + +/// Get the sought expression from the specifier list. +template +static const Fortran::semantics::SomeExpr *getExpr(const A &stmt) { + for (const auto &spec : stmt.v) + if (auto *f = std::get_if(&spec.u)) + return Fortran::semantics::GetExpr(f->v); + llvm_unreachable("must have a file unit"); +} + +/// For each specifier, build the appropriate call, threading the cookie, and +/// returning the insertion point as to the initial context. If there are no +/// specifiers, the insertion point is undefined. +template +static mlir::OpBuilder::InsertPoint +threadSpecs(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, const A &specList, bool checkResult, + mlir::Value &ok) { + auto &builder = converter.getFirOpBuilder(); + mlir::OpBuilder::InsertPoint insertPt; + for (const auto &spec : specList) { + makeNextConditionalOn(builder, loc, insertPt, checkResult, ok); + ok = std::visit(Fortran::common::visitors{[&](const auto &x) { + return genIOOption(converter, loc, cookie, x); + }}, + spec.u); + } + return insertPt; +} + +template +static void +genConditionHandlerCall(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Value cookie, + const A &specList, ConditionSpecifierInfo &csi) { + for (const auto &spec : specList) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::StatVariable &msgVar) { + csi.ioStatExpr = Fortran::semantics::GetExpr(msgVar); + }, + [&](const Fortran::parser::MsgVariable &msgVar) { + csi.ioMsgExpr = Fortran::semantics::GetExpr(msgVar); + }, + [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; }, + [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; }, + [&](const Fortran::parser::ErrLabel &) { csi.hasErr = true; }, + [](const auto &) {}}, + spec.u); + } + if (!csi.hasAnyConditionSpecifier()) + return; + auto &builder = converter.getFirOpBuilder(); + mlir::FuncOp enableHandlers = + getIORuntimeFunc(loc, builder); + mlir::Type boolType = enableHandlers.getType().getInput(1); + auto boolValue = [&](bool specifierIsPresent) { + return builder.create( + loc, builder.getIntegerAttr(boolType, specifierIsPresent)); + }; + llvm::SmallVector ioArgs = { + cookie, + boolValue(csi.ioStatExpr != nullptr), + boolValue(csi.hasErr), + boolValue(csi.hasEnd), + boolValue(csi.hasEor), + boolValue(csi.ioMsgExpr != nullptr)}; + builder.create(loc, enableHandlers, ioArgs); +} + +//===----------------------------------------------------------------------===// +// Data transfer helpers +//===----------------------------------------------------------------------===// + +template +static bool hasIOControl(const A &stmt) { + return hasX(stmt.controls); +} + +template +static const auto *getIOControl(const A &stmt) { + for (const auto &spec : stmt.controls) + if (const auto *result = std::get_if(&spec.u)) + return result; + return static_cast(nullptr); +} + +/// returns true iff the expression in the parse tree is not really a format but +/// rather a namelist variable. +template +static bool formatIsActuallyNamelist(const A &format) { + if (auto *e = std::get_if(&format.u)) { + auto *expr = Fortran::semantics::GetExpr(*e); + if (const Fortran::semantics::Symbol *y = + Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) + return y->has(); + } + return false; +} + +template +static bool isDataTransferFormatted(const A &stmt) { + if (stmt.format) + return !formatIsActuallyNamelist(*stmt.format); + return hasIOControl(stmt); +} +template <> +constexpr bool isDataTransferFormatted( + const Fortran::parser::PrintStmt &) { + return true; // PRINT is always formatted +} + +template +static bool isDataTransferList(const A &stmt) { + if (stmt.format) + return std::holds_alternative(stmt.format->u); + if (auto *mem = getIOControl(stmt)) + return std::holds_alternative(mem->u); + return false; +} +template <> +bool isDataTransferList( + const Fortran::parser::PrintStmt &stmt) { + return std::holds_alternative( + std::get(stmt.t).u); +} + +template +static bool isDataTransferInternal(const A &stmt) { + if (stmt.iounit.has_value()) + return std::holds_alternative(stmt.iounit->u); + if (auto *unit = getIOControl(stmt)) + return std::holds_alternative(unit->u); + return false; +} +template <> +constexpr bool isDataTransferInternal( + const Fortran::parser::PrintStmt &) { + return false; +} + +static bool hasNonDefaultCharKind(const Fortran::parser::Variable &var) { + // TODO + return false; +} + +template +static bool isDataTransferInternalNotDefaultKind(const A &stmt) { + // same as isDataTransferInternal, but the KIND of the expression is not the + // default KIND. + if (stmt.iounit.has_value()) + if (auto *var = std::get_if(&stmt.iounit->u)) + return hasNonDefaultCharKind(*var); + if (auto *unit = getIOControl(stmt)) + if (auto *var = std::get_if(&unit->u)) + return hasNonDefaultCharKind(*var); + return false; +} +template <> +constexpr bool isDataTransferInternalNotDefaultKind( + const Fortran::parser::PrintStmt &) { + return false; +} + +template +static bool isDataTransferAsynchronous(const A &stmt) { + if (auto *asynch = + getIOControl(stmt)) { + // FIXME: should contain a string of YES or NO + llvm_unreachable("asynchronous transfers not implemented in runtime"); + } + return false; +} +template <> +constexpr bool isDataTransferAsynchronous( + const Fortran::parser::PrintStmt &) { + return false; +} + +template +static bool isDataTransferNamelist(const A &stmt) { + if (stmt.format) + return formatIsActuallyNamelist(*stmt.format); + return hasIOControl(stmt); +} +template <> +constexpr bool isDataTransferNamelist( + const Fortran::parser::PrintStmt &) { + return false; +} + +/// Generate a reference to a format string. There are four cases - a format +/// statement label, a character format expression, an integer that holds the +/// label of a format statement, and the * case. The first three are done here. +/// The * case is done elsewhere. +static std::tuple +genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::parser::Format &format, mlir::Type strTy, + mlir::Type lenTy, Fortran::lower::pft::LabelEvalMap &labelMap, + Fortran::lower::pft::SymbolLabelMap &assignMap) { + if (const auto *label = std::get_if(&format.u)) { + // format statement label + auto iter = labelMap.find(*label); + assert(iter != labelMap.end() && "FORMAT not found in PROCEDURE"); + return lowerSourceTextAsStringLit( + converter, loc, toStringRef(iter->second->position), strTy, lenTy); + } + const auto *pExpr = std::get_if(&format.u); + assert(pExpr && "missing format expression"); + auto e = Fortran::semantics::GetExpr(*pExpr); + if (Fortran::semantics::ExprHasTypeCategory( + *e, Fortran::common::TypeCategory::Character)) + // character expression + return lowerStringLit(converter, loc, *pExpr, strTy, lenTy); + // integer variable containing an ASSIGN label + assert(Fortran::semantics::ExprHasTypeCategory( + *e, Fortran::common::TypeCategory::Integer)); + // TODO - implement this + llvm::report_fatal_error( + "using a variable to reference a FORMAT statement; not implemented yet"); +} + +template +std::tuple +getFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const A &stmt, mlir::Type strTy, mlir::Type lenTy, + Fortran::lower::pft::LabelEvalMap &labelMap, + Fortran::lower::pft::SymbolLabelMap &assignMap) { + if (stmt.format && !formatIsActuallyNamelist(*stmt.format)) + return genFormat(converter, loc, *stmt.format, strTy, lenTy, labelMap, + assignMap); + return genFormat(converter, loc, *getIOControl(stmt), + strTy, lenTy, labelMap, assignMap); +} +template <> +std::tuple +getFormat( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::parser::PrintStmt &stmt, mlir::Type strTy, mlir::Type lenTy, + Fortran::lower::pft::LabelEvalMap &labelMap, + Fortran::lower::pft::SymbolLabelMap &assignMap) { + return genFormat(converter, loc, std::get(stmt.t), + strTy, lenTy, labelMap, assignMap); +} + +static std::tuple +genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::parser::IoUnit &iounit, mlir::Type strTy, + mlir::Type lenTy) { + [[maybe_unused]] auto &var = std::get(iounit.u); + TODO(); +} +template +std::tuple +getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const A &stmt, mlir::Type strTy, mlir::Type lenTy) { + if (stmt.iounit) + return genBuffer(converter, loc, *stmt.iounit, strTy, lenTy); + return genBuffer(converter, loc, *getIOControl(stmt), + strTy, lenTy); +} + +template +mlir::Value getDescriptor(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, const A &stmt, + mlir::Type toType) { + TODO(); +} + +static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const Fortran::parser::IoUnit &iounit, + mlir::Type ty) { + auto &builder = converter.getFirOpBuilder(); + if (auto *e = std::get_if(&iounit.u)) { + auto ex = converter.genExprValue(Fortran::semantics::GetExpr(*e), loc); + return builder.createConvert(loc, ty, ex); + } + return builder.create( + loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit)); +} + +template +mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, const A &stmt, mlir::Type ty) { + if (stmt.iounit) + return genIOUnit(converter, loc, *stmt.iounit, ty); + return genIOUnit(converter, loc, *getIOControl(stmt), + ty); +} + +//===----------------------------------------------------------------------===// +// Generators for each I/O statement type. +//===----------------------------------------------------------------------===// + +template +static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter, + const S &stmt) { + auto &builder = converter.getFirOpBuilder(); + auto loc = converter.getCurrentLocation(); + auto beginFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType beginFuncTy = beginFunc.getType(); + auto unit = converter.genExprValue( + getExpr(stmt), loc); + auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); + auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); + auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); + llvm::SmallVector args{un, file, line}; + auto cookie = builder.create(loc, beginFunc, args).getResult(0); + ConditionSpecifierInfo csi{}; + genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); + mlir::Value ok{}; + auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, + csi.hasErrorConditionSpecifier(), ok); + if (insertPt.isSet()) + builder.restoreInsertionPoint(insertPt); + return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); +} + +mlir::Value Fortran::lower::genBackspaceStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::BackspaceStmt &stmt) { + return genBasicIOStmt(converter, stmt); +} + +mlir::Value Fortran::lower::genEndfileStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::EndfileStmt &stmt) { + return genBasicIOStmt(converter, stmt); +} + +mlir::Value +Fortran::lower::genFlushStatement(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::FlushStmt &stmt) { + return genBasicIOStmt(converter, stmt); +} + +mlir::Value +Fortran::lower::genRewindStatement(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::RewindStmt &stmt) { + return genBasicIOStmt(converter, stmt); +} + +mlir::Value +Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::OpenStmt &stmt) { + auto &builder = converter.getFirOpBuilder(); + mlir::FuncOp beginFunc; + llvm::SmallVector beginArgs; + auto loc = converter.getCurrentLocation(); + if (hasMem(stmt)) { + beginFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType beginFuncTy = beginFunc.getType(); + auto unit = converter.genExprValue( + getExpr(stmt), loc); + beginArgs.push_back( + builder.createConvert(loc, beginFuncTy.getInput(0), unit)); + beginArgs.push_back( + getDefaultFilename(builder, loc, beginFuncTy.getInput(1))); + beginArgs.push_back( + getDefaultLineNo(builder, loc, beginFuncTy.getInput(2))); + } else { + assert(hasMem(stmt)); + beginFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType beginFuncTy = beginFunc.getType(); + beginArgs.push_back( + getDefaultFilename(builder, loc, beginFuncTy.getInput(0))); + beginArgs.push_back( + getDefaultLineNo(builder, loc, beginFuncTy.getInput(1))); + } + auto cookie = + builder.create(loc, beginFunc, beginArgs).getResult(0); + ConditionSpecifierInfo csi{}; + genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); + mlir::Value ok{}; + auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, + csi.hasErrorConditionSpecifier(), ok); + if (insertPt.isSet()) + builder.restoreInsertionPoint(insertPt); + return genEndIO(converter, loc, cookie, csi); +} + +mlir::Value +Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::CloseStmt &stmt) { + return genBasicIOStmt(converter, stmt); +} + +mlir::Value +Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::WaitStmt &stmt) { + auto &builder = converter.getFirOpBuilder(); + auto loc = converter.getCurrentLocation(); + bool hasId = hasMem(stmt); + mlir::FuncOp beginFunc = + hasId ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); + mlir::FunctionType beginFuncTy = beginFunc.getType(); + auto unit = converter.genExprValue( + getExpr(stmt), loc); + auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); + llvm::SmallVector args{un}; + if (hasId) { + auto id = + converter.genExprValue(getExpr(stmt), loc); + args.push_back(builder.createConvert(loc, beginFuncTy.getInput(1), id)); + } + auto cookie = builder.create(loc, beginFunc, args).getResult(0); + ConditionSpecifierInfo csi{}; + genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); + return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); +} + +//===----------------------------------------------------------------------===// +// Data transfer statements. +// +// There are several dimensions to the API with regard to data transfer +// statements that need to be considered. +// +// - input (READ) vs. output (WRITE, PRINT) +// - formatted vs. list vs. unformatted +// - synchronous vs. asynchronous +// - namelist vs. list +// - external vs. internal + default KIND vs. internal + other KIND +//===----------------------------------------------------------------------===// + +// Determine the correct BeginXyz{In|Out}put api to invoke. +template +mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder, + bool isFormatted, bool isList, bool isIntern, + bool isOtherIntern, bool isAsynch, + bool isNml) { + if constexpr (isInput) { + if (isAsynch) + return getIORuntimeFunc(loc, builder); + if (isFormatted) { + if (isIntern) { + if (isNml) + return getIORuntimeFunc(loc, + builder); + if (isOtherIntern) { + if (isList) + return getIORuntimeFunc( + loc, builder); + return getIORuntimeFunc( + loc, builder); + } + if (isList) + return getIORuntimeFunc(loc, + builder); + return getIORuntimeFunc(loc, + builder); + } + if (isNml) + return getIORuntimeFunc(loc, + builder); + if (isList) + return getIORuntimeFunc(loc, builder); + return getIORuntimeFunc(loc, + builder); + } + return getIORuntimeFunc(loc, builder); + } else { + if (isAsynch) + return getIORuntimeFunc(loc, builder); + if (isFormatted) { + if (isIntern) { + if (isNml) + return getIORuntimeFunc( + loc, builder); + if (isOtherIntern) { + if (isList) + return getIORuntimeFunc( + loc, builder); + return getIORuntimeFunc( + loc, builder); + } + if (isList) + return getIORuntimeFunc(loc, + builder); + return getIORuntimeFunc(loc, + builder); + } + if (isNml) + return getIORuntimeFunc(loc, + builder); + if (isList) + return getIORuntimeFunc(loc, builder); + return getIORuntimeFunc(loc, + builder); + } + return getIORuntimeFunc(loc, builder); + } +} + +/// Generate the arguments of a BeginXyz call. +template +void genBeginCallArguments(llvm::SmallVector &ioArgs, + Fortran::lower::AbstractConverter &converter, + mlir::Location loc, const A &stmt, + mlir::FunctionType ioFuncTy, bool isFormatted, + bool isList, bool isIntern, bool isOtherIntern, + bool isAsynch, bool isNml, + Fortran::lower::pft::LabelEvalMap &labelMap, + Fortran::lower::pft::SymbolLabelMap &assignMap) { + auto &builder = converter.getFirOpBuilder(); + if constexpr (hasIOCtrl) { + // READ/WRITE cases have a wide variety of argument permutations + if (isAsynch || !isFormatted) { + // unit (always first), ... + ioArgs.push_back( + getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); + if (isAsynch) { + // unknown-thingy, [buff, LEN] + llvm_unreachable("not implemented"); + } + return; + } + assert(isFormatted && "formatted data transfer"); + if (!isIntern) { + if (isNml) { + // namelist group, ... + llvm_unreachable("not implemented"); + } else if (!isList) { + // | [format, LEN], ... + auto pair = getFormat( + converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), + ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); + ioArgs.push_back(std::get<0>(pair)); + ioArgs.push_back(std::get<1>(pair)); + } + // unit (always last) + ioArgs.push_back( + getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); + return; + } + assert(isIntern && "internal data transfer"); + if (isNml || isOtherIntern) { + // descriptor, ... + ioArgs.push_back(getDescriptor(converter, loc, stmt, + ioFuncTy.getInput(ioArgs.size()))); + if (isNml) { + // namelist group, ... + llvm_unreachable("not implemented"); + } else if (isOtherIntern && !isList) { + // | [format, LEN], ... + auto pair = getFormat( + converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), + ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); + ioArgs.push_back(std::get<0>(pair)); + ioArgs.push_back(std::get<1>(pair)); + } + } else { + // | [buff, LEN], ... + auto pair = + getBuffer(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), + ioFuncTy.getInput(ioArgs.size() + 1)); + ioArgs.push_back(std::get<0>(pair)); + ioArgs.push_back(std::get<1>(pair)); + if (!isList) { + // [format, LEN], ... + auto pair = getFormat( + converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), + ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); + ioArgs.push_back(std::get<0>(pair)); + ioArgs.push_back(std::get<1>(pair)); + } + } + // [scratch, LEN] (always last) + ioArgs.push_back( + getDefaultScratch(builder, loc, ioFuncTy.getInput(ioArgs.size()))); + ioArgs.push_back( + getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size()))); + } else { + if (!isList) { + // [format, LEN], ... + auto pair = + getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), + ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); + ioArgs.push_back(std::get<0>(pair)); + ioArgs.push_back(std::get<1>(pair)); + } + // unit (always last) + ioArgs.push_back(builder.create( + loc, builder.getIntegerAttr(ioFuncTy.getInput(ioArgs.size()), + Fortran::runtime::io::DefaultUnit))); + } +} + +template +static mlir::Value +genDataTransferStmt(Fortran::lower::AbstractConverter &converter, const A &stmt, + Fortran::lower::pft::LabelEvalMap &labelMap, + Fortran::lower::pft::SymbolLabelMap &assignMap) { + auto &builder = converter.getFirOpBuilder(); + auto loc = converter.getCurrentLocation(); + const bool isFormatted = isDataTransferFormatted(stmt); + const bool isList = isFormatted ? isDataTransferList(stmt) : false; + const bool isIntern = isDataTransferInternal(stmt); + const bool isOtherIntern = + isIntern ? isDataTransferInternalNotDefaultKind(stmt) : false; + const bool isAsynch = isDataTransferAsynchronous(stmt); + const bool isNml = isDataTransferNamelist(stmt); + + // Determine which BeginXyz call to make. + mlir::FuncOp ioFunc = + getBeginDataTransfer(loc, builder, isFormatted, isList, isIntern, + isOtherIntern, isAsynch, isNml); + mlir::FunctionType ioFuncTy = ioFunc.getType(); + + // Append BeginXyz call arguments. File name and line number are always last. + llvm::SmallVector ioArgs; + genBeginCallArguments(ioArgs, converter, loc, stmt, ioFuncTy, + isFormatted, isList, isIntern, isOtherIntern, + isAsynch, isNml, labelMap, assignMap); + ioArgs.push_back( + getDefaultFilename(builder, loc, ioFuncTy.getInput(ioArgs.size()))); + ioArgs.push_back( + getDefaultLineNo(builder, loc, ioFuncTy.getInput(ioArgs.size()))); + + // Arguments are done; call the BeginXyz function. + mlir::Value cookie = + builder.create(loc, ioFunc, ioArgs).getResult(0); + + // Generate an EnableHandlers call and remaining specifier calls. + ConditionSpecifierInfo csi; + mlir::OpBuilder::InsertPoint insertPt; + mlir::Value ok; + if constexpr (hasIOCtrl) { + genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi); + insertPt = threadSpecs(converter, loc, cookie, stmt.controls, + csi.hasErrorConditionSpecifier(), ok); + } + + // Generate data transfer list calls. + if constexpr (isInput) // ReadStmt + genInputItemList(converter, cookie, stmt.items, insertPt, + csi.hasTransferConditionSpecifier(), ok, false); + else if constexpr (std::is_same_v) + genOutputItemList(converter, cookie, std::get<1>(stmt.t), insertPt, + csi.hasTransferConditionSpecifier(), ok, false); + else // WriteStmt + genOutputItemList(converter, cookie, stmt.items, insertPt, + csi.hasTransferConditionSpecifier(), ok, false); + + // Generate end statement call/s. + if (insertPt.isSet()) + builder.restoreInsertionPoint(insertPt); + return genEndIO(converter, loc, cookie, csi); +} + +void Fortran::lower::genPrintStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::PrintStmt &stmt, + Fortran::lower::pft::LabelEvalMap &labelMap, + Fortran::lower::pft::SymbolLabelMap &assignMap) { + // PRINT does not take an io-control-spec. It only has a format specifier, so + // it is a simplified case of WRITE. + genDataTransferStmt(converter, stmt, + labelMap, assignMap); +} + +mlir::Value Fortran::lower::genWriteStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::WriteStmt &stmt, + Fortran::lower::pft::LabelEvalMap &labelMap, + Fortran::lower::pft::SymbolLabelMap &assignMap) { + return genDataTransferStmt(converter, stmt, labelMap, + assignMap); +} + +mlir::Value Fortran::lower::genReadStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::ReadStmt &stmt, + Fortran::lower::pft::LabelEvalMap &labelMap, + Fortran::lower::pft::SymbolLabelMap &assignMap) { + return genDataTransferStmt(converter, stmt, labelMap, + assignMap); +} + +/// Get the file expression from the inquire spec list. Also return if the +/// expression is a file name. +static std::pair +getInquireFileExpr(const std::list *stmt) { + if (!stmt) + return {nullptr, false}; + for (const auto &spec : *stmt) { + if (auto *f = std::get_if(&spec.u)) + return {Fortran::semantics::GetExpr(*f), false}; + if (auto *f = std::get_if(&spec.u)) + return {Fortran::semantics::GetExpr(*f), true}; + } + // semantics should have already caught this condition + llvm_unreachable("inquire spec must have a file"); +} + +mlir::Value Fortran::lower::genInquireStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::InquireStmt &stmt) { + auto &builder = converter.getFirOpBuilder(); + auto loc = converter.getCurrentLocation(); + mlir::FuncOp beginFunc; + mlir::Value cookie; + ConditionSpecifierInfo csi{}; + const auto *list = + std::get_if>(&stmt.u); + auto exprPair = getInquireFileExpr(list); + auto inquireFileUnit = [&]() -> bool { + return exprPair.first && !exprPair.second; + }; + auto inquireFileName = [&]() -> bool { + return exprPair.first && exprPair.second; + }; + + // Determine which BeginInquire call to make. + if (inquireFileUnit()) { + // File unit call. + beginFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType beginFuncTy = beginFunc.getType(); + auto unit = converter.genExprValue(exprPair.first, loc); + auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); + auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); + auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); + llvm::SmallVector beginArgs{un, file, line}; + cookie = + builder.create(loc, beginFunc, beginArgs).getResult(0); + // Handle remaining arguments in specifier list. + genConditionHandlerCall(converter, loc, cookie, *list, csi); + } else if (inquireFileName()) { + // Filename call. + beginFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType beginFuncTy = beginFunc.getType(); + auto file = converter.genExprValue(exprPair.first, loc); + // Helper to query [BUFFER, LEN]. + Fortran::lower::CharacterExprHelper helper(builder, loc); + auto dataLen = helper.materializeCharacter(file); + auto buff = + builder.createConvert(loc, beginFuncTy.getInput(0), dataLen.first); + auto len = + builder.createConvert(loc, beginFuncTy.getInput(1), dataLen.second); + auto kindInt = helper.getCharacterKind(file.getType()); + mlir::Value kindValue = + builder.createIntegerConstant(loc, beginFuncTy.getInput(2), kindInt); + auto sourceFile = getDefaultFilename(builder, loc, beginFuncTy.getInput(3)); + auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(4)); + llvm::SmallVector beginArgs = { + buff, len, kindValue, sourceFile, line, + }; + cookie = + builder.create(loc, beginFunc, beginArgs).getResult(0); + // Handle remaining arguments in specifier list. + genConditionHandlerCall(converter, loc, cookie, *list, csi); + } else { + // Io length call. + const auto *ioLength = + std::get_if(&stmt.u); + assert(ioLength && "must have an io length"); + beginFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType beginFuncTy = beginFunc.getType(); + auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(0)); + auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(1)); + llvm::SmallVector beginArgs{file, line}; + cookie = + builder.create(loc, beginFunc, beginArgs).getResult(0); + // Handle remaining arguments in output list. + genConditionHandlerCall( + converter, loc, cookie, + std::get>(ioLength->t), csi); + } + // Generate end statement call. + return genEndIO(converter, loc, cookie, csi); +}