diff --git a/flang/include/flang/Lower/IO.h b/flang/include/flang/Lower/IO.h deleted file mode 100644 --- a/flang/include/flang/Lower/IO.h +++ /dev/null @@ -1,98 +0,0 @@ -//===-- 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 @@ -7,7 +7,6 @@ CharacterRuntime.cpp Coarray.cpp ConvertType.cpp - IO.cpp Mangler.cpp OpenACC.cpp OpenMP.cpp diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp deleted file mode 100644 --- a/flang/lib/Lower/IO.cpp +++ /dev/null @@ -1,1478 +0,0 @@ -//===-- 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 "RTBuilder.h" -#include "flang/Lower/Bridge.h" -#include "flang/Lower/CharacterExpr.h" -#include "flang/Lower/PFTBuilder.h" -#include "flang/Lower/Runtime.h" -#include "flang/Lower/Utils.h" -#include "flang/Optimizer/Builder/Complex.h" -#include "flang/Optimizer/Builder/FIRBuilder.h" -#include "flang/Parser/parse-tree.h" -#include "flang/Runtime/io-api.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(BeginExternalListOutput), - mkIOKey(BeginExternalListInput), mkIOKey(BeginExternalFormattedOutput), - mkIOKey(BeginExternalFormattedInput), mkIOKey(BeginUnformattedOutput), - mkIOKey(BeginUnformattedInput), 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(SetCarriagecontrol), 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, - fir::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(fir::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.thenRegion().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, - fir::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 = fir::factory::Complex{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, fir::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( - fir::factory::Complex{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.thenRegion().front().back(); - builder.setInsertionPointAfter(lastOp); - builder.create(loc, lastOp->getResult(0)); // runtime result - builder.setInsertionPointToStart(&whereOp.elseRegion().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(fir::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(fir::FirOpBuilder &builder, - mlir::Location loc, mlir::Type toType) { - return builder.create( - loc, builder.getIntegerAttr(toType, 0)); -} - -static mlir::Value getDefaultScratch(fir::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(fir::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.createStringLitOp(loc, 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::Carriagecontrol: - 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 group -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, fir::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 (isOtherIntern) { - if (isList || isNml) - return getIORuntimeFunc( - loc, builder); - return getIORuntimeFunc( - loc, builder); - } - if (isList || isNml) - return getIORuntimeFunc(loc, - builder); - return getIORuntimeFunc(loc, - builder); - } - if (isList || isNml) - return getIORuntimeFunc(loc, builder); - return getIORuntimeFunc(loc, - builder); - } - return getIORuntimeFunc(loc, builder); - } else { - if (isAsynch) - return getIORuntimeFunc(loc, builder); - if (isFormatted) { - if (isIntern) { - if (isOtherIntern) { - if (isList || isNml) - return getIORuntimeFunc( - loc, builder); - return getIORuntimeFunc( - loc, builder); - } - if (isList || isNml) - return getIORuntimeFunc(loc, - builder); - return getIORuntimeFunc(loc, - builder); - } - if (isList || isNml) - 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); -}