//===-- 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(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, 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::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 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); }