1 //===-- IO.cpp -- I/O statement lowering ----------------------------------===// 2 // 3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4 // See https://llvm.org/LICENSE.txt for license information. 5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #include "flang/Lower/IO.h" 10 #include "RTBuilder.h" 11 #include "flang/Lower/Bridge.h" 12 #include "flang/Lower/CharacterExpr.h" 13 #include "flang/Lower/ComplexExpr.h" 14 #include "flang/Lower/FIRBuilder.h" 15 #include "flang/Lower/PFTBuilder.h" 16 #include "flang/Lower/Runtime.h" 17 #include "flang/Lower/Utils.h" 18 #include "flang/Parser/parse-tree.h" 19 #include "flang/Runtime/io-api.h" 20 #include "flang/Semantics/tools.h" 21 #include "mlir/Dialect/StandardOps/IR/Ops.h" 22 23 #define TODO() llvm_unreachable("not yet implemented") 24 25 using namespace Fortran::runtime::io; 26 27 #define NAMIFY_HELPER(X) #X 28 #define NAMIFY(X) NAMIFY_HELPER(IONAME(X)) 29 #define mkIOKey(X) mkKey(IONAME(X)) 30 31 namespace Fortran::lower { 32 /// Static table of IO runtime calls 33 /// 34 /// This logical map contains the name and type builder function for each IO 35 /// runtime function listed in the tuple. This table is fully constructed at 36 /// compile-time. Use the `mkIOKey` macro to access the table. 37 static constexpr std::tuple< 38 mkIOKey(BeginInternalArrayListOutput), mkIOKey(BeginInternalArrayListInput), 39 mkIOKey(BeginInternalArrayFormattedOutput), 40 mkIOKey(BeginInternalArrayFormattedInput), mkIOKey(BeginInternalListOutput), 41 mkIOKey(BeginInternalListInput), mkIOKey(BeginInternalFormattedOutput), 42 mkIOKey(BeginInternalFormattedInput), mkIOKey(BeginExternalListOutput), 43 mkIOKey(BeginExternalListInput), mkIOKey(BeginExternalFormattedOutput), 44 mkIOKey(BeginExternalFormattedInput), mkIOKey(BeginUnformattedOutput), 45 mkIOKey(BeginUnformattedInput), mkIOKey(BeginAsynchronousOutput), 46 mkIOKey(BeginAsynchronousInput), mkIOKey(BeginWait), mkIOKey(BeginWaitAll), 47 mkIOKey(BeginClose), mkIOKey(BeginFlush), mkIOKey(BeginBackspace), 48 mkIOKey(BeginEndfile), mkIOKey(BeginRewind), mkIOKey(BeginOpenUnit), 49 mkIOKey(BeginOpenNewUnit), mkIOKey(BeginInquireUnit), 50 mkIOKey(BeginInquireFile), mkIOKey(BeginInquireIoLength), 51 mkIOKey(EnableHandlers), mkIOKey(SetAdvance), mkIOKey(SetBlank), 52 mkIOKey(SetDecimal), mkIOKey(SetDelim), mkIOKey(SetPad), mkIOKey(SetPos), 53 mkIOKey(SetRec), mkIOKey(SetRound), mkIOKey(SetSign), 54 mkIOKey(OutputDescriptor), mkIOKey(InputDescriptor), 55 mkIOKey(OutputUnformattedBlock), mkIOKey(InputUnformattedBlock), 56 mkIOKey(OutputInteger64), mkIOKey(InputInteger), mkIOKey(OutputReal32), 57 mkIOKey(InputReal32), mkIOKey(OutputReal64), mkIOKey(InputReal64), 58 mkIOKey(OutputComplex64), mkIOKey(OutputComplex32), mkIOKey(OutputAscii), 59 mkIOKey(InputAscii), mkIOKey(OutputLogical), mkIOKey(InputLogical), 60 mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAsynchronous), 61 mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding), mkIOKey(SetForm), 62 mkIOKey(SetPosition), mkIOKey(SetRecl), mkIOKey(SetStatus), 63 mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize), 64 mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter), 65 mkIOKey(InquireLogical), mkIOKey(InquirePendingId), 66 mkIOKey(InquireInteger64), mkIOKey(EndIoStatement)> 67 newIOTable; 68 } // namespace Fortran::lower 69 70 namespace { 71 struct ConditionSpecifierInfo { 72 const Fortran::semantics::SomeExpr *ioStatExpr{}; 73 const Fortran::semantics::SomeExpr *ioMsgExpr{}; 74 bool hasErr{}; 75 bool hasEnd{}; 76 bool hasEor{}; 77 78 /// Check for any condition specifier that applies to specifier processing. 79 bool hasErrorConditionSpecifier() const { 80 return ioStatExpr != nullptr || hasErr; 81 } 82 /// Check for any condition specifier that applies to data transfer items 83 /// in a PRINT, READ, WRITE, or WAIT statement. (WAIT may be irrelevant.) 84 bool hasTransferConditionSpecifier() const { 85 return ioStatExpr != nullptr || hasErr || hasEnd || hasEor; 86 } 87 /// Check for any condition specifier, including IOMSG. 88 bool hasAnyConditionSpecifier() const { 89 return ioStatExpr != nullptr || ioMsgExpr != nullptr || hasErr || hasEnd || 90 hasEor; 91 } 92 }; 93 } // namespace 94 95 using namespace Fortran::lower; 96 97 /// Helper function to retrieve the name of the IO function given the key `A` 98 template <typename A> 99 static constexpr const char *getName() { 100 return std::get<A>(newIOTable).name; 101 } 102 103 /// Helper function to retrieve the type model signature builder of the IO 104 /// function as defined by the key `A` 105 template <typename A> 106 static constexpr FuncTypeBuilderFunc getTypeModel() { 107 return std::get<A>(newIOTable).getTypeModel(); 108 } 109 110 inline int64_t getLength(mlir::Type argTy) { 111 return argTy.cast<fir::SequenceType>().getShape()[0]; 112 } 113 114 /// Get (or generate) the MLIR FuncOp for a given IO runtime function. 115 template <typename E> 116 static mlir::FuncOp getIORuntimeFunc(mlir::Location loc, 117 Fortran::lower::FirOpBuilder &builder) { 118 auto name = getName<E>(); 119 auto func = builder.getNamedFunction(name); 120 if (func) 121 return func; 122 auto funTy = getTypeModel<E>()(builder.getContext()); 123 func = builder.createFunction(loc, name, funTy); 124 func->setAttr("fir.runtime", builder.getUnitAttr()); 125 func->setAttr("fir.io", builder.getUnitAttr()); 126 return func; 127 } 128 129 /// Generate calls to end an IO statement. Return the IOSTAT value, if any. 130 /// It is the caller's responsibility to generate branches on that value. 131 static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter, 132 mlir::Location loc, mlir::Value cookie, 133 const ConditionSpecifierInfo &csi) { 134 auto &builder = converter.getFirOpBuilder(); 135 if (csi.ioMsgExpr) { 136 auto getIoMsg = getIORuntimeFunc<mkIOKey(GetIoMsg)>(loc, builder); 137 auto ioMsgVar = 138 Fortran::lower::CharacterExprHelper{builder, loc}.createUnboxChar( 139 converter.genExprAddr(csi.ioMsgExpr, loc)); 140 llvm::SmallVector<mlir::Value, 3> args{ 141 cookie, 142 builder.createConvert(loc, getIoMsg.getType().getInput(1), 143 ioMsgVar.first), 144 builder.createConvert(loc, getIoMsg.getType().getInput(2), 145 ioMsgVar.second)}; 146 builder.create<mlir::CallOp>(loc, getIoMsg, args); 147 } 148 auto endIoStatement = getIORuntimeFunc<mkIOKey(EndIoStatement)>(loc, builder); 149 llvm::SmallVector<mlir::Value, 1> endArgs{cookie}; 150 auto call = builder.create<mlir::CallOp>(loc, endIoStatement, endArgs); 151 if (csi.ioStatExpr) { 152 auto ioStatVar = converter.genExprAddr(csi.ioStatExpr, loc); 153 auto ioStatResult = builder.createConvert( 154 loc, converter.genType(*csi.ioStatExpr), call.getResult(0)); 155 builder.create<fir::StoreOp>(loc, ioStatResult, ioStatVar); 156 } 157 return csi.hasTransferConditionSpecifier() ? call.getResult(0) 158 : mlir::Value{}; 159 } 160 161 /// Make the next call in the IO statement conditional on runtime result `ok`. 162 /// If a call returns `ok==false`, further suboperation calls for an I/O 163 /// statement will be skipped. This may generate branch heavy, deeply nested 164 /// conditionals for I/O statements with a large number of suboperations. 165 static void makeNextConditionalOn(Fortran::lower::FirOpBuilder &builder, 166 mlir::Location loc, 167 mlir::OpBuilder::InsertPoint &insertPt, 168 bool checkResult, mlir::Value ok, 169 bool inIterWhileLoop = false) { 170 if (!checkResult || !ok) 171 // Either I/O calls do not need to be checked, or the next I/O call is the 172 // first potentially fallable call. 173 return; 174 // A previous I/O call for a statement returned the bool `ok`. If this call 175 // is in a fir.iterate_while loop, the result must be propagated up to the 176 // loop scope. That is done in genIoLoop, but it is enabled here. 177 auto whereOp = 178 inIterWhileLoop 179 ? builder.create<fir::IfOp>(loc, builder.getI1Type(), ok, true) 180 : builder.create<fir::IfOp>(loc, ok, /*withOtherwise=*/false); 181 if (!insertPt.isSet()) 182 insertPt = builder.saveInsertionPoint(); 183 builder.setInsertionPointToStart(&whereOp.thenRegion().front()); 184 } 185 186 template <typename D> 187 static void genIoLoop(Fortran::lower::AbstractConverter &converter, 188 mlir::Value cookie, const D &ioImpliedDo, 189 bool checkResult, mlir::Value &ok, bool inIterWhileLoop); 190 191 /// Get the OutputXyz routine to output a value of the given type. 192 static mlir::FuncOp getOutputFunc(mlir::Location loc, 193 Fortran::lower::FirOpBuilder &builder, 194 mlir::Type type) { 195 if (auto ty = type.dyn_cast<mlir::IntegerType>()) 196 return ty.getWidth() == 1 197 ? getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder) 198 : getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder); 199 if (auto ty = type.dyn_cast<mlir::FloatType>()) 200 return ty.getWidth() <= 32 201 ? getIORuntimeFunc<mkIOKey(OutputReal32)>(loc, builder) 202 : getIORuntimeFunc<mkIOKey(OutputReal64)>(loc, builder); 203 if (auto ty = type.dyn_cast<fir::ComplexType>()) 204 return ty.getFKind() <= 4 205 ? getIORuntimeFunc<mkIOKey(OutputComplex32)>(loc, builder) 206 : getIORuntimeFunc<mkIOKey(OutputComplex64)>(loc, builder); 207 if (type.isa<fir::LogicalType>()) 208 return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder); 209 if (type.isa<fir::BoxType>()) 210 return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder); 211 if (Fortran::lower::CharacterExprHelper::isCharacter(type)) 212 return getIORuntimeFunc<mkIOKey(OutputAscii)>(loc, builder); 213 // TODO: handle arrays 214 mlir::emitError(loc, "output for entity type ") << type << " not implemented"; 215 return {}; 216 } 217 218 /// Generate a sequence of output data transfer calls. 219 static void 220 genOutputItemList(Fortran::lower::AbstractConverter &converter, 221 mlir::Value cookie, 222 const std::list<Fortran::parser::OutputItem> &items, 223 mlir::OpBuilder::InsertPoint &insertPt, bool checkResult, 224 mlir::Value &ok, bool inIterWhileLoop) { 225 auto &builder = converter.getFirOpBuilder(); 226 for (auto &item : items) { 227 if (const auto &impliedDo = std::get_if<1>(&item.u)) { 228 genIoLoop(converter, cookie, impliedDo->value(), checkResult, ok, 229 inIterWhileLoop); 230 continue; 231 } 232 auto &pExpr = std::get<Fortran::parser::Expr>(item.u); 233 auto loc = converter.genLocation(pExpr.source); 234 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, 235 inIterWhileLoop); 236 auto itemValue = 237 converter.genExprValue(Fortran::semantics::GetExpr(pExpr), loc); 238 auto itemType = itemValue.getType(); 239 auto outputFunc = getOutputFunc(loc, builder, itemType); 240 auto argType = outputFunc.getType().getInput(1); 241 llvm::SmallVector<mlir::Value, 3> outputFuncArgs = {cookie}; 242 Fortran::lower::CharacterExprHelper helper{builder, loc}; 243 if (helper.isCharacter(itemType)) { 244 auto dataLen = helper.materializeCharacter(itemValue); 245 outputFuncArgs.push_back(builder.createConvert( 246 loc, outputFunc.getType().getInput(1), dataLen.first)); 247 outputFuncArgs.push_back(builder.createConvert( 248 loc, outputFunc.getType().getInput(2), dataLen.second)); 249 } else if (fir::isa_complex(itemType)) { 250 auto parts = Fortran::lower::ComplexExprHelper{builder, loc}.extractParts( 251 itemValue); 252 outputFuncArgs.push_back(parts.first); 253 outputFuncArgs.push_back(parts.second); 254 } else { 255 itemValue = builder.createConvert(loc, argType, itemValue); 256 outputFuncArgs.push_back(itemValue); 257 } 258 ok = builder.create<mlir::CallOp>(loc, outputFunc, outputFuncArgs) 259 .getResult(0); 260 } 261 } 262 263 /// Get the InputXyz routine to input a value of the given type. 264 static mlir::FuncOp getInputFunc(mlir::Location loc, 265 Fortran::lower::FirOpBuilder &builder, 266 mlir::Type type) { 267 if (auto ty = type.dyn_cast<mlir::IntegerType>()) 268 return ty.getWidth() == 1 269 ? getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder) 270 : getIORuntimeFunc<mkIOKey(InputInteger)>(loc, builder); 271 if (auto ty = type.dyn_cast<mlir::FloatType>()) 272 return ty.getWidth() <= 32 273 ? getIORuntimeFunc<mkIOKey(InputReal32)>(loc, builder) 274 : getIORuntimeFunc<mkIOKey(InputReal64)>(loc, builder); 275 if (auto ty = type.dyn_cast<fir::ComplexType>()) 276 return ty.getFKind() <= 4 277 ? getIORuntimeFunc<mkIOKey(InputReal32)>(loc, builder) 278 : getIORuntimeFunc<mkIOKey(InputReal64)>(loc, builder); 279 if (type.isa<fir::LogicalType>()) 280 return getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder); 281 if (type.isa<fir::BoxType>()) 282 return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder); 283 if (Fortran::lower::CharacterExprHelper::isCharacter(type)) 284 return getIORuntimeFunc<mkIOKey(InputAscii)>(loc, builder); 285 // TODO: handle arrays 286 mlir::emitError(loc, "input for entity type ") << type << " not implemented"; 287 return {}; 288 } 289 290 /// Generate a sequence of input data transfer calls. 291 static void genInputItemList(Fortran::lower::AbstractConverter &converter, 292 mlir::Value cookie, 293 const std::list<Fortran::parser::InputItem> &items, 294 mlir::OpBuilder::InsertPoint &insertPt, 295 bool checkResult, mlir::Value &ok, 296 bool inIterWhileLoop) { 297 auto &builder = converter.getFirOpBuilder(); 298 for (auto &item : items) { 299 if (const auto &impliedDo = std::get_if<1>(&item.u)) { 300 genIoLoop(converter, cookie, impliedDo->value(), checkResult, ok, 301 inIterWhileLoop); 302 continue; 303 } 304 auto &pVar = std::get<Fortran::parser::Variable>(item.u); 305 auto loc = converter.genLocation(pVar.GetSource()); 306 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, 307 inIterWhileLoop); 308 auto itemAddr = 309 converter.genExprAddr(Fortran::semantics::GetExpr(pVar), loc); 310 auto itemType = itemAddr.getType().cast<fir::ReferenceType>().getEleTy(); 311 auto inputFunc = getInputFunc(loc, builder, itemType); 312 auto argType = inputFunc.getType().getInput(1); 313 auto originalItemAddr = itemAddr; 314 mlir::Type complexPartType; 315 if (itemType.isa<fir::ComplexType>()) 316 complexPartType = builder.getRefType( 317 Fortran::lower::ComplexExprHelper{builder, loc}.getComplexPartType( 318 itemType)); 319 auto complexPartAddr = [&](int index) { 320 return builder.create<fir::CoordinateOp>( 321 loc, complexPartType, originalItemAddr, 322 llvm::SmallVector<mlir::Value, 1>{ 323 builder.create<mlir::arith::ConstantOp>( 324 loc, builder.getI32IntegerAttr(index))}); 325 }; 326 if (complexPartType) 327 itemAddr = complexPartAddr(0); // real part 328 itemAddr = builder.createConvert(loc, argType, itemAddr); 329 llvm::SmallVector<mlir::Value, 3> inputFuncArgs = {cookie, itemAddr}; 330 Fortran::lower::CharacterExprHelper helper{builder, loc}; 331 if (helper.isCharacter(itemType)) { 332 auto len = helper.materializeCharacter(originalItemAddr).second; 333 inputFuncArgs.push_back( 334 builder.createConvert(loc, inputFunc.getType().getInput(2), len)); 335 } else if (itemType.isa<mlir::IntegerType>()) { 336 inputFuncArgs.push_back(builder.create<mlir::arith::ConstantOp>( 337 loc, builder.getI32IntegerAttr( 338 itemType.cast<mlir::IntegerType>().getWidth() / 8))); 339 } 340 ok = builder.create<mlir::CallOp>(loc, inputFunc, inputFuncArgs) 341 .getResult(0); 342 if (complexPartType) { // imaginary part 343 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, 344 inIterWhileLoop); 345 inputFuncArgs = {cookie, 346 builder.createConvert(loc, argType, complexPartAddr(1))}; 347 ok = builder.create<mlir::CallOp>(loc, inputFunc, inputFuncArgs) 348 .getResult(0); 349 } 350 } 351 } 352 353 /// Generate an io-implied-do loop. 354 template <typename D> 355 static void genIoLoop(Fortran::lower::AbstractConverter &converter, 356 mlir::Value cookie, const D &ioImpliedDo, 357 bool checkResult, mlir::Value &ok, bool inIterWhileLoop) { 358 mlir::OpBuilder::InsertPoint insertPt; 359 auto &builder = converter.getFirOpBuilder(); 360 auto loc = converter.getCurrentLocation(); 361 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, 362 inIterWhileLoop); 363 auto parentInsertPt = builder.saveInsertionPoint(); 364 const auto &itemList = std::get<0>(ioImpliedDo.t); 365 const auto &control = std::get<1>(ioImpliedDo.t); 366 const auto &loopSym = *control.name.thing.thing.symbol; 367 auto loopVar = converter.getSymbolAddress(loopSym); 368 auto genFIRLoopIndex = [&](const Fortran::parser::ScalarIntExpr &expr) { 369 return builder.createConvert( 370 loc, builder.getIndexType(), 371 converter.genExprValue(*Fortran::semantics::GetExpr(expr))); 372 }; 373 auto lowerValue = genFIRLoopIndex(control.lower); 374 auto upperValue = genFIRLoopIndex(control.upper); 375 auto stepValue = control.step.has_value() 376 ? genFIRLoopIndex(*control.step) 377 : builder.create<mlir::arith::ConstantIndexOp>(loc, 1); 378 auto genItemList = [&](const D &ioImpliedDo, bool inIterWhileLoop) { 379 if constexpr (std::is_same_v<D, Fortran::parser::InputImpliedDo>) 380 genInputItemList(converter, cookie, itemList, insertPt, checkResult, ok, 381 true); 382 else 383 genOutputItemList(converter, cookie, itemList, insertPt, checkResult, ok, 384 true); 385 }; 386 if (!checkResult) { 387 // No I/O call result checks - the loop is a fir.do_loop op. 388 auto loopOp = 389 builder.create<fir::DoLoopOp>(loc, lowerValue, upperValue, stepValue); 390 builder.setInsertionPointToStart(loopOp.getBody()); 391 auto lcv = builder.createConvert(loc, converter.genType(loopSym), 392 loopOp.getInductionVar()); 393 builder.create<fir::StoreOp>(loc, lcv, loopVar); 394 insertPt = builder.saveInsertionPoint(); 395 genItemList(ioImpliedDo, false); 396 builder.restoreInsertionPoint(parentInsertPt); 397 return; 398 } 399 // Check I/O call results - the loop is a fir.iterate_while op. 400 if (!ok) 401 ok = builder.createIntegerConstant(loc, builder.getI1Type(), 1); 402 fir::IterWhileOp iterWhileOp = builder.create<fir::IterWhileOp>( 403 loc, lowerValue, upperValue, stepValue, ok); 404 builder.setInsertionPointToStart(iterWhileOp.getBody()); 405 auto lcv = builder.createConvert(loc, converter.genType(loopSym), 406 iterWhileOp.getInductionVar()); 407 builder.create<fir::StoreOp>(loc, lcv, loopVar); 408 insertPt = builder.saveInsertionPoint(); 409 ok = iterWhileOp.getIterateVar(); 410 auto falseValue = builder.createIntegerConstant(loc, builder.getI1Type(), 0); 411 genItemList(ioImpliedDo, true); 412 // Unwind nested I/O call scopes, filling in true and false ResultOp's. 413 for (auto *op = builder.getBlock()->getParentOp(); isa<fir::IfOp>(op); 414 op = op->getBlock()->getParentOp()) { 415 auto whereOp = dyn_cast<fir::IfOp>(op); 416 auto *lastOp = &whereOp.thenRegion().front().back(); 417 builder.setInsertionPointAfter(lastOp); 418 builder.create<fir::ResultOp>(loc, lastOp->getResult(0)); // runtime result 419 builder.setInsertionPointToStart(&whereOp.elseRegion().front()); 420 builder.create<fir::ResultOp>(loc, falseValue); // known false result 421 } 422 builder.restoreInsertionPoint(insertPt); 423 builder.create<fir::ResultOp>(loc, builder.getBlock()->back().getResult(0)); 424 ok = iterWhileOp.getResult(0); 425 builder.restoreInsertionPoint(parentInsertPt); 426 } 427 428 //===----------------------------------------------------------------------===// 429 // Default argument generation. 430 //===----------------------------------------------------------------------===// 431 432 static mlir::Value getDefaultFilename(Fortran::lower::FirOpBuilder &builder, 433 mlir::Location loc, mlir::Type toType) { 434 mlir::Value null = builder.create<mlir::arith::ConstantOp>( 435 loc, builder.getI64IntegerAttr(0)); 436 return builder.createConvert(loc, toType, null); 437 } 438 439 static mlir::Value getDefaultLineNo(Fortran::lower::FirOpBuilder &builder, 440 mlir::Location loc, mlir::Type toType) { 441 return builder.create<mlir::arith::ConstantOp>( 442 loc, builder.getIntegerAttr(toType, 0)); 443 } 444 445 static mlir::Value getDefaultScratch(Fortran::lower::FirOpBuilder &builder, 446 mlir::Location loc, mlir::Type toType) { 447 mlir::Value null = builder.create<mlir::arith::ConstantOp>( 448 loc, builder.getI64IntegerAttr(0)); 449 return builder.createConvert(loc, toType, null); 450 } 451 452 static mlir::Value getDefaultScratchLen(Fortran::lower::FirOpBuilder &builder, 453 mlir::Location loc, mlir::Type toType) { 454 return builder.create<mlir::arith::ConstantOp>( 455 loc, builder.getIntegerAttr(toType, 0)); 456 } 457 458 /// Lower a string literal. Many arguments to the runtime are conveyed as 459 /// Fortran CHARACTER literals. 460 template <typename A> 461 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 462 lowerStringLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 463 const A &syntax, mlir::Type strTy, mlir::Type lenTy, 464 mlir::Type ty2 = {}) { 465 auto &builder = converter.getFirOpBuilder(); 466 auto *expr = Fortran::semantics::GetExpr(syntax); 467 auto str = converter.genExprValue(expr, loc); 468 Fortran::lower::CharacterExprHelper helper{builder, loc}; 469 auto dataLen = helper.materializeCharacter(str); 470 auto buff = builder.createConvert(loc, strTy, dataLen.first); 471 auto len = builder.createConvert(loc, lenTy, dataLen.second); 472 if (ty2) { 473 auto kindVal = helper.getCharacterKind(str.getType()); 474 auto kind = builder.create<mlir::arith::ConstantOp>( 475 loc, builder.getIntegerAttr(ty2, kindVal)); 476 return {buff, len, kind}; 477 } 478 return {buff, len, mlir::Value{}}; 479 } 480 481 /// Pass the body of the FORMAT statement in as if it were a CHARACTER literal 482 /// constant. NB: This is the prescribed manner in which the front-end passes 483 /// this information to lowering. 484 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 485 lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter, 486 mlir::Location loc, llvm::StringRef text, 487 mlir::Type strTy, mlir::Type lenTy) { 488 text = text.drop_front(text.find('(')); 489 text = text.take_front(text.rfind(')') + 1); 490 auto &builder = converter.getFirOpBuilder(); 491 auto lit = builder.createStringLit( 492 loc, /*FIXME*/ fir::CharacterType::get(builder.getContext(), 1, 1), text); 493 auto data = 494 Fortran::lower::CharacterExprHelper{builder, loc}.materializeCharacter( 495 lit); 496 auto buff = builder.createConvert(loc, strTy, data.first); 497 auto len = builder.createConvert(loc, lenTy, data.second); 498 return {buff, len, mlir::Value{}}; 499 } 500 501 //===----------------------------------------------------------------------===// 502 // Handle I/O statement specifiers. 503 // These are threaded together for a single statement via the passed cookie. 504 //===----------------------------------------------------------------------===// 505 506 /// Generic to build an integral argument to the runtime. 507 template <typename A, typename B> 508 mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter, 509 mlir::Location loc, mlir::Value cookie, 510 const B &spec) { 511 auto &builder = converter.getFirOpBuilder(); 512 mlir::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder); 513 mlir::FunctionType ioFuncTy = ioFunc.getType(); 514 auto expr = converter.genExprValue(Fortran::semantics::GetExpr(spec.v), loc); 515 auto val = builder.createConvert(loc, ioFuncTy.getInput(1), expr); 516 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, val}; 517 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 518 } 519 520 /// Generic to build a string argument to the runtime. This passes a CHARACTER 521 /// as a pointer to the buffer and a LEN parameter. 522 template <typename A, typename B> 523 mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter, 524 mlir::Location loc, mlir::Value cookie, 525 const B &spec) { 526 auto &builder = converter.getFirOpBuilder(); 527 mlir::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder); 528 mlir::FunctionType ioFuncTy = ioFunc.getType(); 529 auto tup = lowerStringLit(converter, loc, spec, ioFuncTy.getInput(1), 530 ioFuncTy.getInput(2)); 531 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, std::get<0>(tup), 532 std::get<1>(tup)}; 533 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 534 } 535 536 template <typename A> 537 mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter, 538 mlir::Location loc, mlir::Value cookie, const A &spec) { 539 // default case: do nothing 540 return {}; 541 } 542 543 template <> 544 mlir::Value genIOOption<Fortran::parser::FileNameExpr>( 545 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 546 mlir::Value cookie, const Fortran::parser::FileNameExpr &spec) { 547 auto &builder = converter.getFirOpBuilder(); 548 // has an extra KIND argument 549 auto ioFunc = getIORuntimeFunc<mkIOKey(SetFile)>(loc, builder); 550 mlir::FunctionType ioFuncTy = ioFunc.getType(); 551 auto tup = lowerStringLit(converter, loc, spec, ioFuncTy.getInput(1), 552 ioFuncTy.getInput(2), ioFuncTy.getInput(3)); 553 llvm::SmallVector<mlir::Value, 4> ioArgs{cookie, std::get<0>(tup), 554 std::get<1>(tup), std::get<2>(tup)}; 555 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 556 } 557 558 template <> 559 mlir::Value genIOOption<Fortran::parser::ConnectSpec::CharExpr>( 560 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 561 mlir::Value cookie, const Fortran::parser::ConnectSpec::CharExpr &spec) { 562 auto &builder = converter.getFirOpBuilder(); 563 mlir::FuncOp ioFunc; 564 switch (std::get<Fortran::parser::ConnectSpec::CharExpr::Kind>(spec.t)) { 565 case Fortran::parser::ConnectSpec::CharExpr::Kind::Access: 566 ioFunc = getIORuntimeFunc<mkIOKey(SetAccess)>(loc, builder); 567 break; 568 case Fortran::parser::ConnectSpec::CharExpr::Kind::Action: 569 ioFunc = getIORuntimeFunc<mkIOKey(SetAction)>(loc, builder); 570 break; 571 case Fortran::parser::ConnectSpec::CharExpr::Kind::Asynchronous: 572 ioFunc = getIORuntimeFunc<mkIOKey(SetAsynchronous)>(loc, builder); 573 break; 574 case Fortran::parser::ConnectSpec::CharExpr::Kind::Blank: 575 ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder); 576 break; 577 case Fortran::parser::ConnectSpec::CharExpr::Kind::Decimal: 578 ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder); 579 break; 580 case Fortran::parser::ConnectSpec::CharExpr::Kind::Delim: 581 ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder); 582 break; 583 case Fortran::parser::ConnectSpec::CharExpr::Kind::Encoding: 584 ioFunc = getIORuntimeFunc<mkIOKey(SetEncoding)>(loc, builder); 585 break; 586 case Fortran::parser::ConnectSpec::CharExpr::Kind::Form: 587 ioFunc = getIORuntimeFunc<mkIOKey(SetForm)>(loc, builder); 588 break; 589 case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad: 590 ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder); 591 break; 592 case Fortran::parser::ConnectSpec::CharExpr::Kind::Position: 593 ioFunc = getIORuntimeFunc<mkIOKey(SetPosition)>(loc, builder); 594 break; 595 case Fortran::parser::ConnectSpec::CharExpr::Kind::Round: 596 ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder); 597 break; 598 case Fortran::parser::ConnectSpec::CharExpr::Kind::Sign: 599 ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder); 600 break; 601 case Fortran::parser::ConnectSpec::CharExpr::Kind::Carriagecontrol: 602 ioFunc = getIORuntimeFunc<mkIOKey(SetCarriagecontrol)>(loc, builder); 603 break; 604 case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert: 605 llvm_unreachable("CONVERT not part of the runtime::io interface"); 606 case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose: 607 llvm_unreachable("DISPOSE not part of the runtime::io interface"); 608 } 609 mlir::FunctionType ioFuncTy = ioFunc.getType(); 610 auto tup = lowerStringLit( 611 converter, loc, std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t), 612 ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 613 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, std::get<0>(tup), 614 std::get<1>(tup)}; 615 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 616 } 617 618 template <> 619 mlir::Value genIOOption<Fortran::parser::ConnectSpec::Recl>( 620 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 621 mlir::Value cookie, const Fortran::parser::ConnectSpec::Recl &spec) { 622 return genIntIOOption<mkIOKey(SetRecl)>(converter, loc, cookie, spec); 623 } 624 625 template <> 626 mlir::Value genIOOption<Fortran::parser::StatusExpr>( 627 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 628 mlir::Value cookie, const Fortran::parser::StatusExpr &spec) { 629 return genCharIOOption<mkIOKey(SetStatus)>(converter, loc, cookie, spec.v); 630 } 631 632 template <> 633 mlir::Value 634 genIOOption<Fortran::parser::Name>(Fortran::lower::AbstractConverter &converter, 635 mlir::Location loc, mlir::Value cookie, 636 const Fortran::parser::Name &spec) { 637 // namelist 638 llvm_unreachable("not implemented"); 639 } 640 641 template <> 642 mlir::Value genIOOption<Fortran::parser::IoControlSpec::CharExpr>( 643 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 644 mlir::Value cookie, const Fortran::parser::IoControlSpec::CharExpr &spec) { 645 auto &builder = converter.getFirOpBuilder(); 646 mlir::FuncOp ioFunc; 647 switch (std::get<Fortran::parser::IoControlSpec::CharExpr::Kind>(spec.t)) { 648 case Fortran::parser::IoControlSpec::CharExpr::Kind::Advance: 649 ioFunc = getIORuntimeFunc<mkIOKey(SetAdvance)>(loc, builder); 650 break; 651 case Fortran::parser::IoControlSpec::CharExpr::Kind::Blank: 652 ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder); 653 break; 654 case Fortran::parser::IoControlSpec::CharExpr::Kind::Decimal: 655 ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder); 656 break; 657 case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim: 658 ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder); 659 break; 660 case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad: 661 ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder); 662 break; 663 case Fortran::parser::IoControlSpec::CharExpr::Kind::Round: 664 ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder); 665 break; 666 case Fortran::parser::IoControlSpec::CharExpr::Kind::Sign: 667 ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder); 668 break; 669 } 670 mlir::FunctionType ioFuncTy = ioFunc.getType(); 671 auto tup = lowerStringLit( 672 converter, loc, std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t), 673 ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 674 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, std::get<0>(tup), 675 std::get<1>(tup)}; 676 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 677 } 678 679 template <> 680 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Asynchronous>( 681 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 682 mlir::Value cookie, 683 const Fortran::parser::IoControlSpec::Asynchronous &spec) { 684 return genCharIOOption<mkIOKey(SetAsynchronous)>(converter, loc, cookie, 685 spec.v); 686 } 687 688 template <> 689 mlir::Value genIOOption<Fortran::parser::IdVariable>( 690 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 691 mlir::Value cookie, const Fortran::parser::IdVariable &spec) { 692 llvm_unreachable("asynchronous ID not implemented"); 693 } 694 695 template <> 696 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Pos>( 697 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 698 mlir::Value cookie, const Fortran::parser::IoControlSpec::Pos &spec) { 699 return genIntIOOption<mkIOKey(SetPos)>(converter, loc, cookie, spec); 700 } 701 template <> 702 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Rec>( 703 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 704 mlir::Value cookie, const Fortran::parser::IoControlSpec::Rec &spec) { 705 return genIntIOOption<mkIOKey(SetRec)>(converter, loc, cookie, spec); 706 } 707 708 //===----------------------------------------------------------------------===// 709 // Gather I/O statement condition specifier information (if any). 710 //===----------------------------------------------------------------------===// 711 712 template <typename SEEK, typename A> 713 static bool hasX(const A &list) { 714 for (const auto &spec : list) 715 if (std::holds_alternative<SEEK>(spec.u)) 716 return true; 717 return false; 718 } 719 720 template <typename SEEK, typename A> 721 static bool hasMem(const A &stmt) { 722 return hasX<SEEK>(stmt.v); 723 } 724 725 /// Get the sought expression from the specifier list. 726 template <typename SEEK, typename A> 727 static const Fortran::semantics::SomeExpr *getExpr(const A &stmt) { 728 for (const auto &spec : stmt.v) 729 if (auto *f = std::get_if<SEEK>(&spec.u)) 730 return Fortran::semantics::GetExpr(f->v); 731 llvm_unreachable("must have a file unit"); 732 } 733 734 /// For each specifier, build the appropriate call, threading the cookie, and 735 /// returning the insertion point as to the initial context. If there are no 736 /// specifiers, the insertion point is undefined. 737 template <typename A> 738 static mlir::OpBuilder::InsertPoint 739 threadSpecs(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 740 mlir::Value cookie, const A &specList, bool checkResult, 741 mlir::Value &ok) { 742 auto &builder = converter.getFirOpBuilder(); 743 mlir::OpBuilder::InsertPoint insertPt; 744 for (const auto &spec : specList) { 745 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok); 746 ok = std::visit(Fortran::common::visitors{[&](const auto &x) { 747 return genIOOption(converter, loc, cookie, x); 748 }}, 749 spec.u); 750 } 751 return insertPt; 752 } 753 754 template <typename A> 755 static void 756 genConditionHandlerCall(Fortran::lower::AbstractConverter &converter, 757 mlir::Location loc, mlir::Value cookie, 758 const A &specList, ConditionSpecifierInfo &csi) { 759 for (const auto &spec : specList) { 760 std::visit( 761 Fortran::common::visitors{ 762 [&](const Fortran::parser::StatVariable &msgVar) { 763 csi.ioStatExpr = Fortran::semantics::GetExpr(msgVar); 764 }, 765 [&](const Fortran::parser::MsgVariable &msgVar) { 766 csi.ioMsgExpr = Fortran::semantics::GetExpr(msgVar); 767 }, 768 [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; }, 769 [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; }, 770 [&](const Fortran::parser::ErrLabel &) { csi.hasErr = true; }, 771 [](const auto &) {}}, 772 spec.u); 773 } 774 if (!csi.hasAnyConditionSpecifier()) 775 return; 776 auto &builder = converter.getFirOpBuilder(); 777 mlir::FuncOp enableHandlers = 778 getIORuntimeFunc<mkIOKey(EnableHandlers)>(loc, builder); 779 mlir::Type boolType = enableHandlers.getType().getInput(1); 780 auto boolValue = [&](bool specifierIsPresent) { 781 return builder.create<mlir::arith::ConstantOp>( 782 loc, builder.getIntegerAttr(boolType, specifierIsPresent)); 783 }; 784 llvm::SmallVector<mlir::Value, 6> ioArgs = { 785 cookie, 786 boolValue(csi.ioStatExpr != nullptr), 787 boolValue(csi.hasErr), 788 boolValue(csi.hasEnd), 789 boolValue(csi.hasEor), 790 boolValue(csi.ioMsgExpr != nullptr)}; 791 builder.create<mlir::CallOp>(loc, enableHandlers, ioArgs); 792 } 793 794 //===----------------------------------------------------------------------===// 795 // Data transfer helpers 796 //===----------------------------------------------------------------------===// 797 798 template <typename SEEK, typename A> 799 static bool hasIOControl(const A &stmt) { 800 return hasX<SEEK>(stmt.controls); 801 } 802 803 template <typename SEEK, typename A> 804 static const auto *getIOControl(const A &stmt) { 805 for (const auto &spec : stmt.controls) 806 if (const auto *result = std::get_if<SEEK>(&spec.u)) 807 return result; 808 return static_cast<const SEEK *>(nullptr); 809 } 810 811 /// returns true iff the expression in the parse tree is not really a format but 812 /// rather a namelist group 813 template <typename A> 814 static bool formatIsActuallyNamelist(const A &format) { 815 if (auto *e = std::get_if<Fortran::parser::Expr>(&format.u)) { 816 auto *expr = Fortran::semantics::GetExpr(*e); 817 if (const Fortran::semantics::Symbol *y = 818 Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) 819 return y->has<Fortran::semantics::NamelistDetails>(); 820 } 821 return false; 822 } 823 824 template <typename A> 825 static bool isDataTransferFormatted(const A &stmt) { 826 if (stmt.format) 827 return !formatIsActuallyNamelist(*stmt.format); 828 return hasIOControl<Fortran::parser::Format>(stmt); 829 } 830 template <> 831 constexpr bool isDataTransferFormatted<Fortran::parser::PrintStmt>( 832 const Fortran::parser::PrintStmt &) { 833 return true; // PRINT is always formatted 834 } 835 836 template <typename A> 837 static bool isDataTransferList(const A &stmt) { 838 if (stmt.format) 839 return std::holds_alternative<Fortran::parser::Star>(stmt.format->u); 840 if (auto *mem = getIOControl<Fortran::parser::Format>(stmt)) 841 return std::holds_alternative<Fortran::parser::Star>(mem->u); 842 return false; 843 } 844 template <> 845 bool isDataTransferList<Fortran::parser::PrintStmt>( 846 const Fortran::parser::PrintStmt &stmt) { 847 return std::holds_alternative<Fortran::parser::Star>( 848 std::get<Fortran::parser::Format>(stmt.t).u); 849 } 850 851 template <typename A> 852 static bool isDataTransferInternal(const A &stmt) { 853 if (stmt.iounit.has_value()) 854 return std::holds_alternative<Fortran::parser::Variable>(stmt.iounit->u); 855 if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt)) 856 return std::holds_alternative<Fortran::parser::Variable>(unit->u); 857 return false; 858 } 859 template <> 860 constexpr bool isDataTransferInternal<Fortran::parser::PrintStmt>( 861 const Fortran::parser::PrintStmt &) { 862 return false; 863 } 864 865 static bool hasNonDefaultCharKind(const Fortran::parser::Variable &var) { 866 // TODO 867 return false; 868 } 869 870 template <typename A> 871 static bool isDataTransferInternalNotDefaultKind(const A &stmt) { 872 // same as isDataTransferInternal, but the KIND of the expression is not the 873 // default KIND. 874 if (stmt.iounit.has_value()) 875 if (auto *var = std::get_if<Fortran::parser::Variable>(&stmt.iounit->u)) 876 return hasNonDefaultCharKind(*var); 877 if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt)) 878 if (auto *var = std::get_if<Fortran::parser::Variable>(&unit->u)) 879 return hasNonDefaultCharKind(*var); 880 return false; 881 } 882 template <> 883 constexpr bool isDataTransferInternalNotDefaultKind<Fortran::parser::PrintStmt>( 884 const Fortran::parser::PrintStmt &) { 885 return false; 886 } 887 888 template <typename A> 889 static bool isDataTransferAsynchronous(const A &stmt) { 890 if (auto *asynch = 891 getIOControl<Fortran::parser::IoControlSpec::Asynchronous>(stmt)) { 892 // FIXME: should contain a string of YES or NO 893 llvm_unreachable("asynchronous transfers not implemented in runtime"); 894 } 895 return false; 896 } 897 template <> 898 constexpr bool isDataTransferAsynchronous<Fortran::parser::PrintStmt>( 899 const Fortran::parser::PrintStmt &) { 900 return false; 901 } 902 903 template <typename A> 904 static bool isDataTransferNamelist(const A &stmt) { 905 if (stmt.format) 906 return formatIsActuallyNamelist(*stmt.format); 907 return hasIOControl<Fortran::parser::Name>(stmt); 908 } 909 template <> 910 constexpr bool isDataTransferNamelist<Fortran::parser::PrintStmt>( 911 const Fortran::parser::PrintStmt &) { 912 return false; 913 } 914 915 /// Generate a reference to a format string. There are four cases - a format 916 /// statement label, a character format expression, an integer that holds the 917 /// label of a format statement, and the * case. The first three are done here. 918 /// The * case is done elsewhere. 919 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 920 genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 921 const Fortran::parser::Format &format, mlir::Type strTy, 922 mlir::Type lenTy, Fortran::lower::pft::LabelEvalMap &labelMap, 923 Fortran::lower::pft::SymbolLabelMap &assignMap) { 924 if (const auto *label = std::get_if<Fortran::parser::Label>(&format.u)) { 925 // format statement label 926 auto iter = labelMap.find(*label); 927 assert(iter != labelMap.end() && "FORMAT not found in PROCEDURE"); 928 return lowerSourceTextAsStringLit( 929 converter, loc, toStringRef(iter->second->position), strTy, lenTy); 930 } 931 const auto *pExpr = std::get_if<Fortran::parser::Expr>(&format.u); 932 assert(pExpr && "missing format expression"); 933 auto e = Fortran::semantics::GetExpr(*pExpr); 934 if (Fortran::semantics::ExprHasTypeCategory( 935 *e, Fortran::common::TypeCategory::Character)) 936 // character expression 937 return lowerStringLit(converter, loc, *pExpr, strTy, lenTy); 938 // integer variable containing an ASSIGN label 939 assert(Fortran::semantics::ExprHasTypeCategory( 940 *e, Fortran::common::TypeCategory::Integer)); 941 // TODO - implement this 942 llvm::report_fatal_error( 943 "using a variable to reference a FORMAT statement; not implemented yet"); 944 } 945 946 template <typename A> 947 std::tuple<mlir::Value, mlir::Value, mlir::Value> 948 getFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 949 const A &stmt, mlir::Type strTy, mlir::Type lenTy, 950 Fortran::lower::pft::LabelEvalMap &labelMap, 951 Fortran::lower::pft::SymbolLabelMap &assignMap) { 952 if (stmt.format && !formatIsActuallyNamelist(*stmt.format)) 953 return genFormat(converter, loc, *stmt.format, strTy, lenTy, labelMap, 954 assignMap); 955 return genFormat(converter, loc, *getIOControl<Fortran::parser::Format>(stmt), 956 strTy, lenTy, labelMap, assignMap); 957 } 958 template <> 959 std::tuple<mlir::Value, mlir::Value, mlir::Value> 960 getFormat<Fortran::parser::PrintStmt>( 961 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 962 const Fortran::parser::PrintStmt &stmt, mlir::Type strTy, mlir::Type lenTy, 963 Fortran::lower::pft::LabelEvalMap &labelMap, 964 Fortran::lower::pft::SymbolLabelMap &assignMap) { 965 return genFormat(converter, loc, std::get<Fortran::parser::Format>(stmt.t), 966 strTy, lenTy, labelMap, assignMap); 967 } 968 969 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 970 genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 971 const Fortran::parser::IoUnit &iounit, mlir::Type strTy, 972 mlir::Type lenTy) { 973 [[maybe_unused]] auto &var = std::get<Fortran::parser::Variable>(iounit.u); 974 TODO(); 975 } 976 template <typename A> 977 std::tuple<mlir::Value, mlir::Value, mlir::Value> 978 getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 979 const A &stmt, mlir::Type strTy, mlir::Type lenTy) { 980 if (stmt.iounit) 981 return genBuffer(converter, loc, *stmt.iounit, strTy, lenTy); 982 return genBuffer(converter, loc, *getIOControl<Fortran::parser::IoUnit>(stmt), 983 strTy, lenTy); 984 } 985 986 template <typename A> 987 mlir::Value getDescriptor(Fortran::lower::AbstractConverter &converter, 988 mlir::Location loc, const A &stmt, 989 mlir::Type toType) { 990 TODO(); 991 } 992 993 static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter, 994 mlir::Location loc, 995 const Fortran::parser::IoUnit &iounit, 996 mlir::Type ty) { 997 auto &builder = converter.getFirOpBuilder(); 998 if (auto *e = std::get_if<Fortran::parser::FileUnitNumber>(&iounit.u)) { 999 auto ex = converter.genExprValue(Fortran::semantics::GetExpr(*e), loc); 1000 return builder.createConvert(loc, ty, ex); 1001 } 1002 return builder.create<mlir::arith::ConstantOp>( 1003 loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit)); 1004 } 1005 1006 template <typename A> 1007 mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter, 1008 mlir::Location loc, const A &stmt, mlir::Type ty) { 1009 if (stmt.iounit) 1010 return genIOUnit(converter, loc, *stmt.iounit, ty); 1011 return genIOUnit(converter, loc, *getIOControl<Fortran::parser::IoUnit>(stmt), 1012 ty); 1013 } 1014 1015 //===----------------------------------------------------------------------===// 1016 // Generators for each I/O statement type. 1017 //===----------------------------------------------------------------------===// 1018 1019 template <typename K, typename S> 1020 static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter, 1021 const S &stmt) { 1022 auto &builder = converter.getFirOpBuilder(); 1023 auto loc = converter.getCurrentLocation(); 1024 auto beginFunc = getIORuntimeFunc<K>(loc, builder); 1025 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1026 auto unit = converter.genExprValue( 1027 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1028 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1029 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); 1030 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); 1031 llvm::SmallVector<mlir::Value, 4> args{un, file, line}; 1032 auto cookie = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0); 1033 ConditionSpecifierInfo csi{}; 1034 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1035 mlir::Value ok{}; 1036 auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, 1037 csi.hasErrorConditionSpecifier(), ok); 1038 if (insertPt.isSet()) 1039 builder.restoreInsertionPoint(insertPt); 1040 return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); 1041 } 1042 1043 mlir::Value Fortran::lower::genBackspaceStatement( 1044 Fortran::lower::AbstractConverter &converter, 1045 const Fortran::parser::BackspaceStmt &stmt) { 1046 return genBasicIOStmt<mkIOKey(BeginBackspace)>(converter, stmt); 1047 } 1048 1049 mlir::Value Fortran::lower::genEndfileStatement( 1050 Fortran::lower::AbstractConverter &converter, 1051 const Fortran::parser::EndfileStmt &stmt) { 1052 return genBasicIOStmt<mkIOKey(BeginEndfile)>(converter, stmt); 1053 } 1054 1055 mlir::Value 1056 Fortran::lower::genFlushStatement(Fortran::lower::AbstractConverter &converter, 1057 const Fortran::parser::FlushStmt &stmt) { 1058 return genBasicIOStmt<mkIOKey(BeginFlush)>(converter, stmt); 1059 } 1060 1061 mlir::Value 1062 Fortran::lower::genRewindStatement(Fortran::lower::AbstractConverter &converter, 1063 const Fortran::parser::RewindStmt &stmt) { 1064 return genBasicIOStmt<mkIOKey(BeginRewind)>(converter, stmt); 1065 } 1066 1067 mlir::Value 1068 Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter, 1069 const Fortran::parser::OpenStmt &stmt) { 1070 auto &builder = converter.getFirOpBuilder(); 1071 mlir::FuncOp beginFunc; 1072 llvm::SmallVector<mlir::Value, 4> beginArgs; 1073 auto loc = converter.getCurrentLocation(); 1074 if (hasMem<Fortran::parser::FileUnitNumber>(stmt)) { 1075 beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenUnit)>(loc, builder); 1076 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1077 auto unit = converter.genExprValue( 1078 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1079 beginArgs.push_back( 1080 builder.createConvert(loc, beginFuncTy.getInput(0), unit)); 1081 beginArgs.push_back( 1082 getDefaultFilename(builder, loc, beginFuncTy.getInput(1))); 1083 beginArgs.push_back( 1084 getDefaultLineNo(builder, loc, beginFuncTy.getInput(2))); 1085 } else { 1086 assert(hasMem<Fortran::parser::ConnectSpec::Newunit>(stmt)); 1087 beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenNewUnit)>(loc, builder); 1088 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1089 beginArgs.push_back( 1090 getDefaultFilename(builder, loc, beginFuncTy.getInput(0))); 1091 beginArgs.push_back( 1092 getDefaultLineNo(builder, loc, beginFuncTy.getInput(1))); 1093 } 1094 auto cookie = 1095 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1096 ConditionSpecifierInfo csi{}; 1097 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1098 mlir::Value ok{}; 1099 auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, 1100 csi.hasErrorConditionSpecifier(), ok); 1101 if (insertPt.isSet()) 1102 builder.restoreInsertionPoint(insertPt); 1103 return genEndIO(converter, loc, cookie, csi); 1104 } 1105 1106 mlir::Value 1107 Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter &converter, 1108 const Fortran::parser::CloseStmt &stmt) { 1109 return genBasicIOStmt<mkIOKey(BeginClose)>(converter, stmt); 1110 } 1111 1112 mlir::Value 1113 Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter, 1114 const Fortran::parser::WaitStmt &stmt) { 1115 auto &builder = converter.getFirOpBuilder(); 1116 auto loc = converter.getCurrentLocation(); 1117 bool hasId = hasMem<Fortran::parser::IdExpr>(stmt); 1118 mlir::FuncOp beginFunc = 1119 hasId ? getIORuntimeFunc<mkIOKey(BeginWait)>(loc, builder) 1120 : getIORuntimeFunc<mkIOKey(BeginWaitAll)>(loc, builder); 1121 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1122 auto unit = converter.genExprValue( 1123 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1124 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1125 llvm::SmallVector<mlir::Value, 4> args{un}; 1126 if (hasId) { 1127 auto id = 1128 converter.genExprValue(getExpr<Fortran::parser::IdExpr>(stmt), loc); 1129 args.push_back(builder.createConvert(loc, beginFuncTy.getInput(1), id)); 1130 } 1131 auto cookie = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0); 1132 ConditionSpecifierInfo csi{}; 1133 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1134 return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); 1135 } 1136 1137 //===----------------------------------------------------------------------===// 1138 // Data transfer statements. 1139 // 1140 // There are several dimensions to the API with regard to data transfer 1141 // statements that need to be considered. 1142 // 1143 // - input (READ) vs. output (WRITE, PRINT) 1144 // - formatted vs. list vs. unformatted 1145 // - synchronous vs. asynchronous 1146 // - namelist vs. list 1147 // - external vs. internal + default KIND vs. internal + other KIND 1148 //===----------------------------------------------------------------------===// 1149 1150 // Determine the correct BeginXyz{In|Out}put api to invoke. 1151 template <bool isInput> 1152 mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder, 1153 bool isFormatted, bool isList, bool isIntern, 1154 bool isOtherIntern, bool isAsynch, 1155 bool isNml) { 1156 if constexpr (isInput) { 1157 if (isAsynch) 1158 return getIORuntimeFunc<mkIOKey(BeginAsynchronousInput)>(loc, builder); 1159 if (isFormatted) { 1160 if (isIntern) { 1161 if (isOtherIntern) { 1162 if (isList || isNml) 1163 return getIORuntimeFunc<mkIOKey(BeginInternalArrayListInput)>( 1164 loc, builder); 1165 return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedInput)>( 1166 loc, builder); 1167 } 1168 if (isList || isNml) 1169 return getIORuntimeFunc<mkIOKey(BeginInternalListInput)>(loc, 1170 builder); 1171 return getIORuntimeFunc<mkIOKey(BeginInternalFormattedInput)>(loc, 1172 builder); 1173 } 1174 if (isList || isNml) 1175 return getIORuntimeFunc<mkIOKey(BeginExternalListInput)>(loc, builder); 1176 return getIORuntimeFunc<mkIOKey(BeginExternalFormattedInput)>(loc, 1177 builder); 1178 } 1179 return getIORuntimeFunc<mkIOKey(BeginUnformattedInput)>(loc, builder); 1180 } else { 1181 if (isAsynch) 1182 return getIORuntimeFunc<mkIOKey(BeginAsynchronousOutput)>(loc, builder); 1183 if (isFormatted) { 1184 if (isIntern) { 1185 if (isOtherIntern) { 1186 if (isList || isNml) 1187 return getIORuntimeFunc<mkIOKey(BeginInternalArrayListOutput)>( 1188 loc, builder); 1189 return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedOutput)>( 1190 loc, builder); 1191 } 1192 if (isList || isNml) 1193 return getIORuntimeFunc<mkIOKey(BeginInternalListOutput)>(loc, 1194 builder); 1195 return getIORuntimeFunc<mkIOKey(BeginInternalFormattedOutput)>(loc, 1196 builder); 1197 } 1198 if (isList || isNml) 1199 return getIORuntimeFunc<mkIOKey(BeginExternalListOutput)>(loc, builder); 1200 return getIORuntimeFunc<mkIOKey(BeginExternalFormattedOutput)>(loc, 1201 builder); 1202 } 1203 return getIORuntimeFunc<mkIOKey(BeginUnformattedOutput)>(loc, builder); 1204 } 1205 } 1206 1207 /// Generate the arguments of a BeginXyz call. 1208 template <bool hasIOCtrl, typename A> 1209 void genBeginCallArguments(llvm::SmallVector<mlir::Value, 8> &ioArgs, 1210 Fortran::lower::AbstractConverter &converter, 1211 mlir::Location loc, const A &stmt, 1212 mlir::FunctionType ioFuncTy, bool isFormatted, 1213 bool isList, bool isIntern, bool isOtherIntern, 1214 bool isAsynch, bool isNml, 1215 Fortran::lower::pft::LabelEvalMap &labelMap, 1216 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1217 auto &builder = converter.getFirOpBuilder(); 1218 if constexpr (hasIOCtrl) { 1219 // READ/WRITE cases have a wide variety of argument permutations 1220 if (isAsynch || !isFormatted) { 1221 // unit (always first), ... 1222 ioArgs.push_back( 1223 getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); 1224 if (isAsynch) { 1225 // unknown-thingy, [buff, LEN] 1226 llvm_unreachable("not implemented"); 1227 } 1228 return; 1229 } 1230 assert(isFormatted && "formatted data transfer"); 1231 if (!isIntern) { 1232 if (isNml) { 1233 // namelist group, ... 1234 llvm_unreachable("not implemented"); 1235 } else if (!isList) { 1236 // | [format, LEN], ... 1237 auto pair = getFormat( 1238 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1239 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1240 ioArgs.push_back(std::get<0>(pair)); 1241 ioArgs.push_back(std::get<1>(pair)); 1242 } 1243 // unit (always last) 1244 ioArgs.push_back( 1245 getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); 1246 return; 1247 } 1248 assert(isIntern && "internal data transfer"); 1249 if (isNml || isOtherIntern) { 1250 // descriptor, ... 1251 ioArgs.push_back(getDescriptor(converter, loc, stmt, 1252 ioFuncTy.getInput(ioArgs.size()))); 1253 if (isNml) { 1254 // namelist group, ... 1255 llvm_unreachable("not implemented"); 1256 } else if (isOtherIntern && !isList) { 1257 // | [format, LEN], ... 1258 auto pair = getFormat( 1259 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1260 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1261 ioArgs.push_back(std::get<0>(pair)); 1262 ioArgs.push_back(std::get<1>(pair)); 1263 } 1264 } else { 1265 // | [buff, LEN], ... 1266 auto pair = 1267 getBuffer(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1268 ioFuncTy.getInput(ioArgs.size() + 1)); 1269 ioArgs.push_back(std::get<0>(pair)); 1270 ioArgs.push_back(std::get<1>(pair)); 1271 if (!isList) { 1272 // [format, LEN], ... 1273 auto pair = getFormat( 1274 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1275 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1276 ioArgs.push_back(std::get<0>(pair)); 1277 ioArgs.push_back(std::get<1>(pair)); 1278 } 1279 } 1280 // [scratch, LEN] (always last) 1281 ioArgs.push_back( 1282 getDefaultScratch(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1283 ioArgs.push_back( 1284 getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1285 } else { 1286 if (!isList) { 1287 // [format, LEN], ... 1288 auto pair = 1289 getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1290 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1291 ioArgs.push_back(std::get<0>(pair)); 1292 ioArgs.push_back(std::get<1>(pair)); 1293 } 1294 // unit (always last) 1295 ioArgs.push_back(builder.create<mlir::arith::ConstantOp>( 1296 loc, builder.getIntegerAttr(ioFuncTy.getInput(ioArgs.size()), 1297 Fortran::runtime::io::DefaultUnit))); 1298 } 1299 } 1300 1301 template <bool isInput, bool hasIOCtrl = true, typename A> 1302 static mlir::Value 1303 genDataTransferStmt(Fortran::lower::AbstractConverter &converter, const A &stmt, 1304 Fortran::lower::pft::LabelEvalMap &labelMap, 1305 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1306 auto &builder = converter.getFirOpBuilder(); 1307 auto loc = converter.getCurrentLocation(); 1308 const bool isFormatted = isDataTransferFormatted(stmt); 1309 const bool isList = isFormatted ? isDataTransferList(stmt) : false; 1310 const bool isIntern = isDataTransferInternal(stmt); 1311 const bool isOtherIntern = 1312 isIntern ? isDataTransferInternalNotDefaultKind(stmt) : false; 1313 const bool isAsynch = isDataTransferAsynchronous(stmt); 1314 const bool isNml = isDataTransferNamelist(stmt); 1315 1316 // Determine which BeginXyz call to make. 1317 mlir::FuncOp ioFunc = 1318 getBeginDataTransfer<isInput>(loc, builder, isFormatted, isList, isIntern, 1319 isOtherIntern, isAsynch, isNml); 1320 mlir::FunctionType ioFuncTy = ioFunc.getType(); 1321 1322 // Append BeginXyz call arguments. File name and line number are always last. 1323 llvm::SmallVector<mlir::Value, 8> ioArgs; 1324 genBeginCallArguments<hasIOCtrl>(ioArgs, converter, loc, stmt, ioFuncTy, 1325 isFormatted, isList, isIntern, isOtherIntern, 1326 isAsynch, isNml, labelMap, assignMap); 1327 ioArgs.push_back( 1328 getDefaultFilename(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1329 ioArgs.push_back( 1330 getDefaultLineNo(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1331 1332 // Arguments are done; call the BeginXyz function. 1333 mlir::Value cookie = 1334 builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 1335 1336 // Generate an EnableHandlers call and remaining specifier calls. 1337 ConditionSpecifierInfo csi; 1338 mlir::OpBuilder::InsertPoint insertPt; 1339 mlir::Value ok; 1340 if constexpr (hasIOCtrl) { 1341 genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi); 1342 insertPt = threadSpecs(converter, loc, cookie, stmt.controls, 1343 csi.hasErrorConditionSpecifier(), ok); 1344 } 1345 1346 // Generate data transfer list calls. 1347 if constexpr (isInput) // ReadStmt 1348 genInputItemList(converter, cookie, stmt.items, insertPt, 1349 csi.hasTransferConditionSpecifier(), ok, false); 1350 else if constexpr (std::is_same_v<A, Fortran::parser::PrintStmt>) 1351 genOutputItemList(converter, cookie, std::get<1>(stmt.t), insertPt, 1352 csi.hasTransferConditionSpecifier(), ok, false); 1353 else // WriteStmt 1354 genOutputItemList(converter, cookie, stmt.items, insertPt, 1355 csi.hasTransferConditionSpecifier(), ok, false); 1356 1357 // Generate end statement call/s. 1358 if (insertPt.isSet()) 1359 builder.restoreInsertionPoint(insertPt); 1360 return genEndIO(converter, loc, cookie, csi); 1361 } 1362 1363 void Fortran::lower::genPrintStatement( 1364 Fortran::lower::AbstractConverter &converter, 1365 const Fortran::parser::PrintStmt &stmt, 1366 Fortran::lower::pft::LabelEvalMap &labelMap, 1367 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1368 // PRINT does not take an io-control-spec. It only has a format specifier, so 1369 // it is a simplified case of WRITE. 1370 genDataTransferStmt</*isInput=*/false, /*ioCtrl=*/false>(converter, stmt, 1371 labelMap, assignMap); 1372 } 1373 1374 mlir::Value Fortran::lower::genWriteStatement( 1375 Fortran::lower::AbstractConverter &converter, 1376 const Fortran::parser::WriteStmt &stmt, 1377 Fortran::lower::pft::LabelEvalMap &labelMap, 1378 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1379 return genDataTransferStmt</*isInput=*/false>(converter, stmt, labelMap, 1380 assignMap); 1381 } 1382 1383 mlir::Value Fortran::lower::genReadStatement( 1384 Fortran::lower::AbstractConverter &converter, 1385 const Fortran::parser::ReadStmt &stmt, 1386 Fortran::lower::pft::LabelEvalMap &labelMap, 1387 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1388 return genDataTransferStmt</*isInput=*/true>(converter, stmt, labelMap, 1389 assignMap); 1390 } 1391 1392 /// Get the file expression from the inquire spec list. Also return if the 1393 /// expression is a file name. 1394 static std::pair<const Fortran::semantics::SomeExpr *, bool> 1395 getInquireFileExpr(const std::list<Fortran::parser::InquireSpec> *stmt) { 1396 if (!stmt) 1397 return {nullptr, false}; 1398 for (const auto &spec : *stmt) { 1399 if (auto *f = std::get_if<Fortran::parser::FileUnitNumber>(&spec.u)) 1400 return {Fortran::semantics::GetExpr(*f), false}; 1401 if (auto *f = std::get_if<Fortran::parser::FileNameExpr>(&spec.u)) 1402 return {Fortran::semantics::GetExpr(*f), true}; 1403 } 1404 // semantics should have already caught this condition 1405 llvm_unreachable("inquire spec must have a file"); 1406 } 1407 1408 mlir::Value Fortran::lower::genInquireStatement( 1409 Fortran::lower::AbstractConverter &converter, 1410 const Fortran::parser::InquireStmt &stmt) { 1411 auto &builder = converter.getFirOpBuilder(); 1412 auto loc = converter.getCurrentLocation(); 1413 mlir::FuncOp beginFunc; 1414 mlir::Value cookie; 1415 ConditionSpecifierInfo csi{}; 1416 const auto *list = 1417 std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u); 1418 auto exprPair = getInquireFileExpr(list); 1419 auto inquireFileUnit = [&]() -> bool { 1420 return exprPair.first && !exprPair.second; 1421 }; 1422 auto inquireFileName = [&]() -> bool { 1423 return exprPair.first && exprPair.second; 1424 }; 1425 1426 // Determine which BeginInquire call to make. 1427 if (inquireFileUnit()) { 1428 // File unit call. 1429 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireUnit)>(loc, builder); 1430 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1431 auto unit = converter.genExprValue(exprPair.first, loc); 1432 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1433 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); 1434 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); 1435 llvm::SmallVector<mlir::Value, 4> beginArgs{un, file, line}; 1436 cookie = 1437 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1438 // Handle remaining arguments in specifier list. 1439 genConditionHandlerCall(converter, loc, cookie, *list, csi); 1440 } else if (inquireFileName()) { 1441 // Filename call. 1442 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireFile)>(loc, builder); 1443 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1444 auto file = converter.genExprValue(exprPair.first, loc); 1445 // Helper to query [BUFFER, LEN]. 1446 Fortran::lower::CharacterExprHelper helper(builder, loc); 1447 auto dataLen = helper.materializeCharacter(file); 1448 auto buff = 1449 builder.createConvert(loc, beginFuncTy.getInput(0), dataLen.first); 1450 auto len = 1451 builder.createConvert(loc, beginFuncTy.getInput(1), dataLen.second); 1452 auto kindInt = helper.getCharacterKind(file.getType()); 1453 mlir::Value kindValue = 1454 builder.createIntegerConstant(loc, beginFuncTy.getInput(2), kindInt); 1455 auto sourceFile = getDefaultFilename(builder, loc, beginFuncTy.getInput(3)); 1456 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(4)); 1457 llvm::SmallVector<mlir::Value, 5> beginArgs = { 1458 buff, len, kindValue, sourceFile, line, 1459 }; 1460 cookie = 1461 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1462 // Handle remaining arguments in specifier list. 1463 genConditionHandlerCall(converter, loc, cookie, *list, csi); 1464 } else { 1465 // Io length call. 1466 const auto *ioLength = 1467 std::get_if<Fortran::parser::InquireStmt::Iolength>(&stmt.u); 1468 assert(ioLength && "must have an io length"); 1469 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireIoLength)>(loc, builder); 1470 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1471 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(0)); 1472 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(1)); 1473 llvm::SmallVector<mlir::Value, 4> beginArgs{file, line}; 1474 cookie = 1475 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1476 // Handle remaining arguments in output list. 1477 genConditionHandlerCall( 1478 converter, loc, cookie, 1479 std::get<std::list<Fortran::parser::OutputItem>>(ioLength->t), csi); 1480 } 1481 // Generate end statement call. 1482 return genEndIO(converter, loc, cookie, csi); 1483 } 1484