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 "../../runtime/io-api.h" 11 #include "RTBuilder.h" 12 #include "flang/Lower/Bridge.h" 13 #include "flang/Lower/CharacterExpr.h" 14 #include "flang/Lower/ComplexExpr.h" 15 #include "flang/Lower/FIRBuilder.h" 16 #include "flang/Lower/PFTBuilder.h" 17 #include "flang/Lower/Runtime.h" 18 #include "flang/Lower/Utils.h" 19 #include "flang/Parser/parse-tree.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>{builder.create<mlir::ConstantOp>( 323 loc, builder.getI32IntegerAttr(index))}); 324 }; 325 if (complexPartType) 326 itemAddr = complexPartAddr(0); // real part 327 itemAddr = builder.createConvert(loc, argType, itemAddr); 328 llvm::SmallVector<mlir::Value, 3> inputFuncArgs = {cookie, itemAddr}; 329 Fortran::lower::CharacterExprHelper helper{builder, loc}; 330 if (helper.isCharacter(itemType)) { 331 auto len = helper.materializeCharacter(originalItemAddr).second; 332 inputFuncArgs.push_back( 333 builder.createConvert(loc, inputFunc.getType().getInput(2), len)); 334 } else if (itemType.isa<mlir::IntegerType>()) { 335 inputFuncArgs.push_back(builder.create<mlir::ConstantOp>( 336 loc, builder.getI32IntegerAttr( 337 itemType.cast<mlir::IntegerType>().getWidth() / 8))); 338 } 339 ok = builder.create<mlir::CallOp>(loc, inputFunc, inputFuncArgs) 340 .getResult(0); 341 if (complexPartType) { // imaginary part 342 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, 343 inIterWhileLoop); 344 inputFuncArgs = {cookie, 345 builder.createConvert(loc, argType, complexPartAddr(1))}; 346 ok = builder.create<mlir::CallOp>(loc, inputFunc, inputFuncArgs) 347 .getResult(0); 348 } 349 } 350 } 351 352 /// Generate an io-implied-do loop. 353 template <typename D> 354 static void genIoLoop(Fortran::lower::AbstractConverter &converter, 355 mlir::Value cookie, const D &ioImpliedDo, 356 bool checkResult, mlir::Value &ok, bool inIterWhileLoop) { 357 mlir::OpBuilder::InsertPoint insertPt; 358 auto &builder = converter.getFirOpBuilder(); 359 auto loc = converter.getCurrentLocation(); 360 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, 361 inIterWhileLoop); 362 auto parentInsertPt = builder.saveInsertionPoint(); 363 const auto &itemList = std::get<0>(ioImpliedDo.t); 364 const auto &control = std::get<1>(ioImpliedDo.t); 365 const auto &loopSym = *control.name.thing.thing.symbol; 366 auto loopVar = converter.getSymbolAddress(loopSym); 367 auto genFIRLoopIndex = [&](const Fortran::parser::ScalarIntExpr &expr) { 368 return builder.createConvert( 369 loc, builder.getIndexType(), 370 converter.genExprValue(*Fortran::semantics::GetExpr(expr))); 371 }; 372 auto lowerValue = genFIRLoopIndex(control.lower); 373 auto upperValue = genFIRLoopIndex(control.upper); 374 auto stepValue = control.step.has_value() 375 ? genFIRLoopIndex(*control.step) 376 : builder.create<mlir::ConstantIndexOp>(loc, 1); 377 auto genItemList = [&](const D &ioImpliedDo, bool inIterWhileLoop) { 378 if constexpr (std::is_same_v<D, Fortran::parser::InputImpliedDo>) 379 genInputItemList(converter, cookie, itemList, insertPt, checkResult, ok, 380 true); 381 else 382 genOutputItemList(converter, cookie, itemList, insertPt, checkResult, ok, 383 true); 384 }; 385 if (!checkResult) { 386 // No I/O call result checks - the loop is a fir.do_loop op. 387 auto loopOp = 388 builder.create<fir::DoLoopOp>(loc, lowerValue, upperValue, stepValue); 389 builder.setInsertionPointToStart(loopOp.getBody()); 390 auto lcv = builder.createConvert(loc, converter.genType(loopSym), 391 loopOp.getInductionVar()); 392 builder.create<fir::StoreOp>(loc, lcv, loopVar); 393 insertPt = builder.saveInsertionPoint(); 394 genItemList(ioImpliedDo, false); 395 builder.restoreInsertionPoint(parentInsertPt); 396 return; 397 } 398 // Check I/O call results - the loop is a fir.iterate_while op. 399 if (!ok) 400 ok = builder.createIntegerConstant(loc, builder.getI1Type(), 1); 401 fir::IterWhileOp iterWhileOp = builder.create<fir::IterWhileOp>( 402 loc, lowerValue, upperValue, stepValue, ok); 403 builder.setInsertionPointToStart(iterWhileOp.getBody()); 404 auto lcv = builder.createConvert(loc, converter.genType(loopSym), 405 iterWhileOp.getInductionVar()); 406 builder.create<fir::StoreOp>(loc, lcv, loopVar); 407 insertPt = builder.saveInsertionPoint(); 408 ok = iterWhileOp.getIterateVar(); 409 auto falseValue = builder.createIntegerConstant(loc, builder.getI1Type(), 0); 410 genItemList(ioImpliedDo, true); 411 // Unwind nested I/O call scopes, filling in true and false ResultOp's. 412 for (auto *op = builder.getBlock()->getParentOp(); isa<fir::IfOp>(op); 413 op = op->getBlock()->getParentOp()) { 414 auto whereOp = dyn_cast<fir::IfOp>(op); 415 auto *lastOp = &whereOp.thenRegion().front().back(); 416 builder.setInsertionPointAfter(lastOp); 417 builder.create<fir::ResultOp>(loc, lastOp->getResult(0)); // runtime result 418 builder.setInsertionPointToStart(&whereOp.elseRegion().front()); 419 builder.create<fir::ResultOp>(loc, falseValue); // known false result 420 } 421 builder.restoreInsertionPoint(insertPt); 422 builder.create<fir::ResultOp>(loc, builder.getBlock()->back().getResult(0)); 423 ok = iterWhileOp.getResult(0); 424 builder.restoreInsertionPoint(parentInsertPt); 425 } 426 427 //===----------------------------------------------------------------------===// 428 // Default argument generation. 429 //===----------------------------------------------------------------------===// 430 431 static mlir::Value getDefaultFilename(Fortran::lower::FirOpBuilder &builder, 432 mlir::Location loc, mlir::Type toType) { 433 mlir::Value null = 434 builder.create<mlir::ConstantOp>(loc, builder.getI64IntegerAttr(0)); 435 return builder.createConvert(loc, toType, null); 436 } 437 438 static mlir::Value getDefaultLineNo(Fortran::lower::FirOpBuilder &builder, 439 mlir::Location loc, mlir::Type toType) { 440 return builder.create<mlir::ConstantOp>(loc, 441 builder.getIntegerAttr(toType, 0)); 442 } 443 444 static mlir::Value getDefaultScratch(Fortran::lower::FirOpBuilder &builder, 445 mlir::Location loc, mlir::Type toType) { 446 mlir::Value null = 447 builder.create<mlir::ConstantOp>(loc, builder.getI64IntegerAttr(0)); 448 return builder.createConvert(loc, toType, null); 449 } 450 451 static mlir::Value getDefaultScratchLen(Fortran::lower::FirOpBuilder &builder, 452 mlir::Location loc, mlir::Type toType) { 453 return builder.create<mlir::ConstantOp>(loc, 454 builder.getIntegerAttr(toType, 0)); 455 } 456 457 /// Lower a string literal. Many arguments to the runtime are conveyed as 458 /// Fortran CHARACTER literals. 459 template <typename A> 460 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 461 lowerStringLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 462 const A &syntax, mlir::Type strTy, mlir::Type lenTy, 463 mlir::Type ty2 = {}) { 464 auto &builder = converter.getFirOpBuilder(); 465 auto *expr = Fortran::semantics::GetExpr(syntax); 466 auto str = converter.genExprValue(expr, loc); 467 Fortran::lower::CharacterExprHelper helper{builder, loc}; 468 auto dataLen = helper.materializeCharacter(str); 469 auto buff = builder.createConvert(loc, strTy, dataLen.first); 470 auto len = builder.createConvert(loc, lenTy, dataLen.second); 471 if (ty2) { 472 auto kindVal = helper.getCharacterKind(str.getType()); 473 auto kind = builder.create<mlir::ConstantOp>( 474 loc, builder.getIntegerAttr(ty2, kindVal)); 475 return {buff, len, kind}; 476 } 477 return {buff, len, mlir::Value{}}; 478 } 479 480 /// Pass the body of the FORMAT statement in as if it were a CHARACTER literal 481 /// constant. NB: This is the prescribed manner in which the front-end passes 482 /// this information to lowering. 483 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 484 lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter, 485 mlir::Location loc, llvm::StringRef text, 486 mlir::Type strTy, mlir::Type lenTy) { 487 text = text.drop_front(text.find('(')); 488 text = text.take_front(text.rfind(')') + 1); 489 auto &builder = converter.getFirOpBuilder(); 490 auto lit = builder.createStringLit( 491 loc, /*FIXME*/ fir::CharacterType::get(builder.getContext(), 1, 1), text); 492 auto data = 493 Fortran::lower::CharacterExprHelper{builder, loc}.materializeCharacter( 494 lit); 495 auto buff = builder.createConvert(loc, strTy, data.first); 496 auto len = builder.createConvert(loc, lenTy, data.second); 497 return {buff, len, mlir::Value{}}; 498 } 499 500 //===----------------------------------------------------------------------===// 501 // Handle I/O statement specifiers. 502 // These are threaded together for a single statement via the passed cookie. 503 //===----------------------------------------------------------------------===// 504 505 /// Generic to build an integral argument to the runtime. 506 template <typename A, typename B> 507 mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter, 508 mlir::Location loc, mlir::Value cookie, 509 const B &spec) { 510 auto &builder = converter.getFirOpBuilder(); 511 mlir::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder); 512 mlir::FunctionType ioFuncTy = ioFunc.getType(); 513 auto expr = converter.genExprValue(Fortran::semantics::GetExpr(spec.v), loc); 514 auto val = builder.createConvert(loc, ioFuncTy.getInput(1), expr); 515 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, val}; 516 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 517 } 518 519 /// Generic to build a string argument to the runtime. This passes a CHARACTER 520 /// as a pointer to the buffer and a LEN parameter. 521 template <typename A, typename B> 522 mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter, 523 mlir::Location loc, mlir::Value cookie, 524 const B &spec) { 525 auto &builder = converter.getFirOpBuilder(); 526 mlir::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder); 527 mlir::FunctionType ioFuncTy = ioFunc.getType(); 528 auto tup = lowerStringLit(converter, loc, spec, ioFuncTy.getInput(1), 529 ioFuncTy.getInput(2)); 530 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, std::get<0>(tup), 531 std::get<1>(tup)}; 532 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 533 } 534 535 template <typename A> 536 mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter, 537 mlir::Location loc, mlir::Value cookie, const A &spec) { 538 // default case: do nothing 539 return {}; 540 } 541 542 template <> 543 mlir::Value genIOOption<Fortran::parser::FileNameExpr>( 544 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 545 mlir::Value cookie, const Fortran::parser::FileNameExpr &spec) { 546 auto &builder = converter.getFirOpBuilder(); 547 // has an extra KIND argument 548 auto ioFunc = getIORuntimeFunc<mkIOKey(SetFile)>(loc, builder); 549 mlir::FunctionType ioFuncTy = ioFunc.getType(); 550 auto tup = lowerStringLit(converter, loc, spec, ioFuncTy.getInput(1), 551 ioFuncTy.getInput(2), ioFuncTy.getInput(3)); 552 llvm::SmallVector<mlir::Value, 4> ioArgs{cookie, std::get<0>(tup), 553 std::get<1>(tup), std::get<2>(tup)}; 554 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 555 } 556 557 template <> 558 mlir::Value genIOOption<Fortran::parser::ConnectSpec::CharExpr>( 559 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 560 mlir::Value cookie, const Fortran::parser::ConnectSpec::CharExpr &spec) { 561 auto &builder = converter.getFirOpBuilder(); 562 mlir::FuncOp ioFunc; 563 switch (std::get<Fortran::parser::ConnectSpec::CharExpr::Kind>(spec.t)) { 564 case Fortran::parser::ConnectSpec::CharExpr::Kind::Access: 565 ioFunc = getIORuntimeFunc<mkIOKey(SetAccess)>(loc, builder); 566 break; 567 case Fortran::parser::ConnectSpec::CharExpr::Kind::Action: 568 ioFunc = getIORuntimeFunc<mkIOKey(SetAction)>(loc, builder); 569 break; 570 case Fortran::parser::ConnectSpec::CharExpr::Kind::Asynchronous: 571 ioFunc = getIORuntimeFunc<mkIOKey(SetAsynchronous)>(loc, builder); 572 break; 573 case Fortran::parser::ConnectSpec::CharExpr::Kind::Blank: 574 ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder); 575 break; 576 case Fortran::parser::ConnectSpec::CharExpr::Kind::Decimal: 577 ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder); 578 break; 579 case Fortran::parser::ConnectSpec::CharExpr::Kind::Delim: 580 ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder); 581 break; 582 case Fortran::parser::ConnectSpec::CharExpr::Kind::Encoding: 583 ioFunc = getIORuntimeFunc<mkIOKey(SetEncoding)>(loc, builder); 584 break; 585 case Fortran::parser::ConnectSpec::CharExpr::Kind::Form: 586 ioFunc = getIORuntimeFunc<mkIOKey(SetForm)>(loc, builder); 587 break; 588 case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad: 589 ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder); 590 break; 591 case Fortran::parser::ConnectSpec::CharExpr::Kind::Position: 592 ioFunc = getIORuntimeFunc<mkIOKey(SetPosition)>(loc, builder); 593 break; 594 case Fortran::parser::ConnectSpec::CharExpr::Kind::Round: 595 ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder); 596 break; 597 case Fortran::parser::ConnectSpec::CharExpr::Kind::Sign: 598 ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder); 599 break; 600 case Fortran::parser::ConnectSpec::CharExpr::Kind::Carriagecontrol: 601 ioFunc = getIORuntimeFunc<mkIOKey(SetCarriagecontrol)>(loc, builder); 602 break; 603 case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert: 604 llvm_unreachable("CONVERT not part of the runtime::io interface"); 605 case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose: 606 llvm_unreachable("DISPOSE not part of the runtime::io interface"); 607 } 608 mlir::FunctionType ioFuncTy = ioFunc.getType(); 609 auto tup = lowerStringLit( 610 converter, loc, std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t), 611 ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 612 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, std::get<0>(tup), 613 std::get<1>(tup)}; 614 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 615 } 616 617 template <> 618 mlir::Value genIOOption<Fortran::parser::ConnectSpec::Recl>( 619 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 620 mlir::Value cookie, const Fortran::parser::ConnectSpec::Recl &spec) { 621 return genIntIOOption<mkIOKey(SetRecl)>(converter, loc, cookie, spec); 622 } 623 624 template <> 625 mlir::Value genIOOption<Fortran::parser::StatusExpr>( 626 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 627 mlir::Value cookie, const Fortran::parser::StatusExpr &spec) { 628 return genCharIOOption<mkIOKey(SetStatus)>(converter, loc, cookie, spec.v); 629 } 630 631 template <> 632 mlir::Value 633 genIOOption<Fortran::parser::Name>(Fortran::lower::AbstractConverter &converter, 634 mlir::Location loc, mlir::Value cookie, 635 const Fortran::parser::Name &spec) { 636 // namelist 637 llvm_unreachable("not implemented"); 638 } 639 640 template <> 641 mlir::Value genIOOption<Fortran::parser::IoControlSpec::CharExpr>( 642 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 643 mlir::Value cookie, const Fortran::parser::IoControlSpec::CharExpr &spec) { 644 auto &builder = converter.getFirOpBuilder(); 645 mlir::FuncOp ioFunc; 646 switch (std::get<Fortran::parser::IoControlSpec::CharExpr::Kind>(spec.t)) { 647 case Fortran::parser::IoControlSpec::CharExpr::Kind::Advance: 648 ioFunc = getIORuntimeFunc<mkIOKey(SetAdvance)>(loc, builder); 649 break; 650 case Fortran::parser::IoControlSpec::CharExpr::Kind::Blank: 651 ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder); 652 break; 653 case Fortran::parser::IoControlSpec::CharExpr::Kind::Decimal: 654 ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder); 655 break; 656 case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim: 657 ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder); 658 break; 659 case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad: 660 ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder); 661 break; 662 case Fortran::parser::IoControlSpec::CharExpr::Kind::Round: 663 ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder); 664 break; 665 case Fortran::parser::IoControlSpec::CharExpr::Kind::Sign: 666 ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder); 667 break; 668 } 669 mlir::FunctionType ioFuncTy = ioFunc.getType(); 670 auto tup = lowerStringLit( 671 converter, loc, std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t), 672 ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 673 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, std::get<0>(tup), 674 std::get<1>(tup)}; 675 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 676 } 677 678 template <> 679 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Asynchronous>( 680 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 681 mlir::Value cookie, 682 const Fortran::parser::IoControlSpec::Asynchronous &spec) { 683 return genCharIOOption<mkIOKey(SetAsynchronous)>(converter, loc, cookie, 684 spec.v); 685 } 686 687 template <> 688 mlir::Value genIOOption<Fortran::parser::IdVariable>( 689 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 690 mlir::Value cookie, const Fortran::parser::IdVariable &spec) { 691 llvm_unreachable("asynchronous ID not implemented"); 692 } 693 694 template <> 695 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Pos>( 696 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 697 mlir::Value cookie, const Fortran::parser::IoControlSpec::Pos &spec) { 698 return genIntIOOption<mkIOKey(SetPos)>(converter, loc, cookie, spec); 699 } 700 template <> 701 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Rec>( 702 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 703 mlir::Value cookie, const Fortran::parser::IoControlSpec::Rec &spec) { 704 return genIntIOOption<mkIOKey(SetRec)>(converter, loc, cookie, spec); 705 } 706 707 //===----------------------------------------------------------------------===// 708 // Gather I/O statement condition specifier information (if any). 709 //===----------------------------------------------------------------------===// 710 711 template <typename SEEK, typename A> 712 static bool hasX(const A &list) { 713 for (const auto &spec : list) 714 if (std::holds_alternative<SEEK>(spec.u)) 715 return true; 716 return false; 717 } 718 719 template <typename SEEK, typename A> 720 static bool hasMem(const A &stmt) { 721 return hasX<SEEK>(stmt.v); 722 } 723 724 /// Get the sought expression from the specifier list. 725 template <typename SEEK, typename A> 726 static const Fortran::semantics::SomeExpr *getExpr(const A &stmt) { 727 for (const auto &spec : stmt.v) 728 if (auto *f = std::get_if<SEEK>(&spec.u)) 729 return Fortran::semantics::GetExpr(f->v); 730 llvm_unreachable("must have a file unit"); 731 } 732 733 /// For each specifier, build the appropriate call, threading the cookie, and 734 /// returning the insertion point as to the initial context. If there are no 735 /// specifiers, the insertion point is undefined. 736 template <typename A> 737 static mlir::OpBuilder::InsertPoint 738 threadSpecs(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 739 mlir::Value cookie, const A &specList, bool checkResult, 740 mlir::Value &ok) { 741 auto &builder = converter.getFirOpBuilder(); 742 mlir::OpBuilder::InsertPoint insertPt; 743 for (const auto &spec : specList) { 744 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok); 745 ok = std::visit(Fortran::common::visitors{[&](const auto &x) { 746 return genIOOption(converter, loc, cookie, x); 747 }}, 748 spec.u); 749 } 750 return insertPt; 751 } 752 753 template <typename A> 754 static void 755 genConditionHandlerCall(Fortran::lower::AbstractConverter &converter, 756 mlir::Location loc, mlir::Value cookie, 757 const A &specList, ConditionSpecifierInfo &csi) { 758 for (const auto &spec : specList) { 759 std::visit( 760 Fortran::common::visitors{ 761 [&](const Fortran::parser::StatVariable &msgVar) { 762 csi.ioStatExpr = Fortran::semantics::GetExpr(msgVar); 763 }, 764 [&](const Fortran::parser::MsgVariable &msgVar) { 765 csi.ioMsgExpr = Fortran::semantics::GetExpr(msgVar); 766 }, 767 [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; }, 768 [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; }, 769 [&](const Fortran::parser::ErrLabel &) { csi.hasErr = true; }, 770 [](const auto &) {}}, 771 spec.u); 772 } 773 if (!csi.hasAnyConditionSpecifier()) 774 return; 775 auto &builder = converter.getFirOpBuilder(); 776 mlir::FuncOp enableHandlers = 777 getIORuntimeFunc<mkIOKey(EnableHandlers)>(loc, builder); 778 mlir::Type boolType = enableHandlers.getType().getInput(1); 779 auto boolValue = [&](bool specifierIsPresent) { 780 return builder.create<mlir::ConstantOp>( 781 loc, builder.getIntegerAttr(boolType, specifierIsPresent)); 782 }; 783 llvm::SmallVector<mlir::Value, 6> ioArgs = { 784 cookie, 785 boolValue(csi.ioStatExpr != nullptr), 786 boolValue(csi.hasErr), 787 boolValue(csi.hasEnd), 788 boolValue(csi.hasEor), 789 boolValue(csi.ioMsgExpr != nullptr)}; 790 builder.create<mlir::CallOp>(loc, enableHandlers, ioArgs); 791 } 792 793 //===----------------------------------------------------------------------===// 794 // Data transfer helpers 795 //===----------------------------------------------------------------------===// 796 797 template <typename SEEK, typename A> 798 static bool hasIOControl(const A &stmt) { 799 return hasX<SEEK>(stmt.controls); 800 } 801 802 template <typename SEEK, typename A> 803 static const auto *getIOControl(const A &stmt) { 804 for (const auto &spec : stmt.controls) 805 if (const auto *result = std::get_if<SEEK>(&spec.u)) 806 return result; 807 return static_cast<const SEEK *>(nullptr); 808 } 809 810 /// returns true iff the expression in the parse tree is not really a format but 811 /// rather a namelist group 812 template <typename A> 813 static bool formatIsActuallyNamelist(const A &format) { 814 if (auto *e = std::get_if<Fortran::parser::Expr>(&format.u)) { 815 auto *expr = Fortran::semantics::GetExpr(*e); 816 if (const Fortran::semantics::Symbol *y = 817 Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) 818 return y->has<Fortran::semantics::NamelistDetails>(); 819 } 820 return false; 821 } 822 823 template <typename A> 824 static bool isDataTransferFormatted(const A &stmt) { 825 if (stmt.format) 826 return !formatIsActuallyNamelist(*stmt.format); 827 return hasIOControl<Fortran::parser::Format>(stmt); 828 } 829 template <> 830 constexpr bool isDataTransferFormatted<Fortran::parser::PrintStmt>( 831 const Fortran::parser::PrintStmt &) { 832 return true; // PRINT is always formatted 833 } 834 835 template <typename A> 836 static bool isDataTransferList(const A &stmt) { 837 if (stmt.format) 838 return std::holds_alternative<Fortran::parser::Star>(stmt.format->u); 839 if (auto *mem = getIOControl<Fortran::parser::Format>(stmt)) 840 return std::holds_alternative<Fortran::parser::Star>(mem->u); 841 return false; 842 } 843 template <> 844 bool isDataTransferList<Fortran::parser::PrintStmt>( 845 const Fortran::parser::PrintStmt &stmt) { 846 return std::holds_alternative<Fortran::parser::Star>( 847 std::get<Fortran::parser::Format>(stmt.t).u); 848 } 849 850 template <typename A> 851 static bool isDataTransferInternal(const A &stmt) { 852 if (stmt.iounit.has_value()) 853 return std::holds_alternative<Fortran::parser::Variable>(stmt.iounit->u); 854 if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt)) 855 return std::holds_alternative<Fortran::parser::Variable>(unit->u); 856 return false; 857 } 858 template <> 859 constexpr bool isDataTransferInternal<Fortran::parser::PrintStmt>( 860 const Fortran::parser::PrintStmt &) { 861 return false; 862 } 863 864 static bool hasNonDefaultCharKind(const Fortran::parser::Variable &var) { 865 // TODO 866 return false; 867 } 868 869 template <typename A> 870 static bool isDataTransferInternalNotDefaultKind(const A &stmt) { 871 // same as isDataTransferInternal, but the KIND of the expression is not the 872 // default KIND. 873 if (stmt.iounit.has_value()) 874 if (auto *var = std::get_if<Fortran::parser::Variable>(&stmt.iounit->u)) 875 return hasNonDefaultCharKind(*var); 876 if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt)) 877 if (auto *var = std::get_if<Fortran::parser::Variable>(&unit->u)) 878 return hasNonDefaultCharKind(*var); 879 return false; 880 } 881 template <> 882 constexpr bool isDataTransferInternalNotDefaultKind<Fortran::parser::PrintStmt>( 883 const Fortran::parser::PrintStmt &) { 884 return false; 885 } 886 887 template <typename A> 888 static bool isDataTransferAsynchronous(const A &stmt) { 889 if (auto *asynch = 890 getIOControl<Fortran::parser::IoControlSpec::Asynchronous>(stmt)) { 891 // FIXME: should contain a string of YES or NO 892 llvm_unreachable("asynchronous transfers not implemented in runtime"); 893 } 894 return false; 895 } 896 template <> 897 constexpr bool isDataTransferAsynchronous<Fortran::parser::PrintStmt>( 898 const Fortran::parser::PrintStmt &) { 899 return false; 900 } 901 902 template <typename A> 903 static bool isDataTransferNamelist(const A &stmt) { 904 if (stmt.format) 905 return formatIsActuallyNamelist(*stmt.format); 906 return hasIOControl<Fortran::parser::Name>(stmt); 907 } 908 template <> 909 constexpr bool isDataTransferNamelist<Fortran::parser::PrintStmt>( 910 const Fortran::parser::PrintStmt &) { 911 return false; 912 } 913 914 /// Generate a reference to a format string. There are four cases - a format 915 /// statement label, a character format expression, an integer that holds the 916 /// label of a format statement, and the * case. The first three are done here. 917 /// The * case is done elsewhere. 918 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 919 genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 920 const Fortran::parser::Format &format, mlir::Type strTy, 921 mlir::Type lenTy, Fortran::lower::pft::LabelEvalMap &labelMap, 922 Fortran::lower::pft::SymbolLabelMap &assignMap) { 923 if (const auto *label = std::get_if<Fortran::parser::Label>(&format.u)) { 924 // format statement label 925 auto iter = labelMap.find(*label); 926 assert(iter != labelMap.end() && "FORMAT not found in PROCEDURE"); 927 return lowerSourceTextAsStringLit( 928 converter, loc, toStringRef(iter->second->position), strTy, lenTy); 929 } 930 const auto *pExpr = std::get_if<Fortran::parser::Expr>(&format.u); 931 assert(pExpr && "missing format expression"); 932 auto e = Fortran::semantics::GetExpr(*pExpr); 933 if (Fortran::semantics::ExprHasTypeCategory( 934 *e, Fortran::common::TypeCategory::Character)) 935 // character expression 936 return lowerStringLit(converter, loc, *pExpr, strTy, lenTy); 937 // integer variable containing an ASSIGN label 938 assert(Fortran::semantics::ExprHasTypeCategory( 939 *e, Fortran::common::TypeCategory::Integer)); 940 // TODO - implement this 941 llvm::report_fatal_error( 942 "using a variable to reference a FORMAT statement; not implemented yet"); 943 } 944 945 template <typename A> 946 std::tuple<mlir::Value, mlir::Value, mlir::Value> 947 getFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 948 const A &stmt, mlir::Type strTy, mlir::Type lenTy, 949 Fortran::lower::pft::LabelEvalMap &labelMap, 950 Fortran::lower::pft::SymbolLabelMap &assignMap) { 951 if (stmt.format && !formatIsActuallyNamelist(*stmt.format)) 952 return genFormat(converter, loc, *stmt.format, strTy, lenTy, labelMap, 953 assignMap); 954 return genFormat(converter, loc, *getIOControl<Fortran::parser::Format>(stmt), 955 strTy, lenTy, labelMap, assignMap); 956 } 957 template <> 958 std::tuple<mlir::Value, mlir::Value, mlir::Value> 959 getFormat<Fortran::parser::PrintStmt>( 960 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 961 const Fortran::parser::PrintStmt &stmt, mlir::Type strTy, mlir::Type lenTy, 962 Fortran::lower::pft::LabelEvalMap &labelMap, 963 Fortran::lower::pft::SymbolLabelMap &assignMap) { 964 return genFormat(converter, loc, std::get<Fortran::parser::Format>(stmt.t), 965 strTy, lenTy, labelMap, assignMap); 966 } 967 968 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 969 genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 970 const Fortran::parser::IoUnit &iounit, mlir::Type strTy, 971 mlir::Type lenTy) { 972 [[maybe_unused]] auto &var = std::get<Fortran::parser::Variable>(iounit.u); 973 TODO(); 974 } 975 template <typename A> 976 std::tuple<mlir::Value, mlir::Value, mlir::Value> 977 getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 978 const A &stmt, mlir::Type strTy, mlir::Type lenTy) { 979 if (stmt.iounit) 980 return genBuffer(converter, loc, *stmt.iounit, strTy, lenTy); 981 return genBuffer(converter, loc, *getIOControl<Fortran::parser::IoUnit>(stmt), 982 strTy, lenTy); 983 } 984 985 template <typename A> 986 mlir::Value getDescriptor(Fortran::lower::AbstractConverter &converter, 987 mlir::Location loc, const A &stmt, 988 mlir::Type toType) { 989 TODO(); 990 } 991 992 static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter, 993 mlir::Location loc, 994 const Fortran::parser::IoUnit &iounit, 995 mlir::Type ty) { 996 auto &builder = converter.getFirOpBuilder(); 997 if (auto *e = std::get_if<Fortran::parser::FileUnitNumber>(&iounit.u)) { 998 auto ex = converter.genExprValue(Fortran::semantics::GetExpr(*e), loc); 999 return builder.createConvert(loc, ty, ex); 1000 } 1001 return builder.create<mlir::ConstantOp>( 1002 loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit)); 1003 } 1004 1005 template <typename A> 1006 mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter, 1007 mlir::Location loc, const A &stmt, mlir::Type ty) { 1008 if (stmt.iounit) 1009 return genIOUnit(converter, loc, *stmt.iounit, ty); 1010 return genIOUnit(converter, loc, *getIOControl<Fortran::parser::IoUnit>(stmt), 1011 ty); 1012 } 1013 1014 //===----------------------------------------------------------------------===// 1015 // Generators for each I/O statement type. 1016 //===----------------------------------------------------------------------===// 1017 1018 template <typename K, typename S> 1019 static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter, 1020 const S &stmt) { 1021 auto &builder = converter.getFirOpBuilder(); 1022 auto loc = converter.getCurrentLocation(); 1023 auto beginFunc = getIORuntimeFunc<K>(loc, builder); 1024 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1025 auto unit = converter.genExprValue( 1026 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1027 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1028 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); 1029 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); 1030 llvm::SmallVector<mlir::Value, 4> args{un, file, line}; 1031 auto cookie = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0); 1032 ConditionSpecifierInfo csi{}; 1033 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1034 mlir::Value ok{}; 1035 auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, 1036 csi.hasErrorConditionSpecifier(), ok); 1037 if (insertPt.isSet()) 1038 builder.restoreInsertionPoint(insertPt); 1039 return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); 1040 } 1041 1042 mlir::Value Fortran::lower::genBackspaceStatement( 1043 Fortran::lower::AbstractConverter &converter, 1044 const Fortran::parser::BackspaceStmt &stmt) { 1045 return genBasicIOStmt<mkIOKey(BeginBackspace)>(converter, stmt); 1046 } 1047 1048 mlir::Value Fortran::lower::genEndfileStatement( 1049 Fortran::lower::AbstractConverter &converter, 1050 const Fortran::parser::EndfileStmt &stmt) { 1051 return genBasicIOStmt<mkIOKey(BeginEndfile)>(converter, stmt); 1052 } 1053 1054 mlir::Value 1055 Fortran::lower::genFlushStatement(Fortran::lower::AbstractConverter &converter, 1056 const Fortran::parser::FlushStmt &stmt) { 1057 return genBasicIOStmt<mkIOKey(BeginFlush)>(converter, stmt); 1058 } 1059 1060 mlir::Value 1061 Fortran::lower::genRewindStatement(Fortran::lower::AbstractConverter &converter, 1062 const Fortran::parser::RewindStmt &stmt) { 1063 return genBasicIOStmt<mkIOKey(BeginRewind)>(converter, stmt); 1064 } 1065 1066 mlir::Value 1067 Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter, 1068 const Fortran::parser::OpenStmt &stmt) { 1069 auto &builder = converter.getFirOpBuilder(); 1070 mlir::FuncOp beginFunc; 1071 llvm::SmallVector<mlir::Value, 4> beginArgs; 1072 auto loc = converter.getCurrentLocation(); 1073 if (hasMem<Fortran::parser::FileUnitNumber>(stmt)) { 1074 beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenUnit)>(loc, builder); 1075 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1076 auto unit = converter.genExprValue( 1077 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1078 beginArgs.push_back( 1079 builder.createConvert(loc, beginFuncTy.getInput(0), unit)); 1080 beginArgs.push_back( 1081 getDefaultFilename(builder, loc, beginFuncTy.getInput(1))); 1082 beginArgs.push_back( 1083 getDefaultLineNo(builder, loc, beginFuncTy.getInput(2))); 1084 } else { 1085 assert(hasMem<Fortran::parser::ConnectSpec::Newunit>(stmt)); 1086 beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenNewUnit)>(loc, builder); 1087 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1088 beginArgs.push_back( 1089 getDefaultFilename(builder, loc, beginFuncTy.getInput(0))); 1090 beginArgs.push_back( 1091 getDefaultLineNo(builder, loc, beginFuncTy.getInput(1))); 1092 } 1093 auto cookie = 1094 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1095 ConditionSpecifierInfo csi{}; 1096 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1097 mlir::Value ok{}; 1098 auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, 1099 csi.hasErrorConditionSpecifier(), ok); 1100 if (insertPt.isSet()) 1101 builder.restoreInsertionPoint(insertPt); 1102 return genEndIO(converter, loc, cookie, csi); 1103 } 1104 1105 mlir::Value 1106 Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter &converter, 1107 const Fortran::parser::CloseStmt &stmt) { 1108 return genBasicIOStmt<mkIOKey(BeginClose)>(converter, stmt); 1109 } 1110 1111 mlir::Value 1112 Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter, 1113 const Fortran::parser::WaitStmt &stmt) { 1114 auto &builder = converter.getFirOpBuilder(); 1115 auto loc = converter.getCurrentLocation(); 1116 bool hasId = hasMem<Fortran::parser::IdExpr>(stmt); 1117 mlir::FuncOp beginFunc = 1118 hasId ? getIORuntimeFunc<mkIOKey(BeginWait)>(loc, builder) 1119 : getIORuntimeFunc<mkIOKey(BeginWaitAll)>(loc, builder); 1120 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1121 auto unit = converter.genExprValue( 1122 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1123 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1124 llvm::SmallVector<mlir::Value, 4> args{un}; 1125 if (hasId) { 1126 auto id = 1127 converter.genExprValue(getExpr<Fortran::parser::IdExpr>(stmt), loc); 1128 args.push_back(builder.createConvert(loc, beginFuncTy.getInput(1), id)); 1129 } 1130 auto cookie = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0); 1131 ConditionSpecifierInfo csi{}; 1132 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1133 return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); 1134 } 1135 1136 //===----------------------------------------------------------------------===// 1137 // Data transfer statements. 1138 // 1139 // There are several dimensions to the API with regard to data transfer 1140 // statements that need to be considered. 1141 // 1142 // - input (READ) vs. output (WRITE, PRINT) 1143 // - formatted vs. list vs. unformatted 1144 // - synchronous vs. asynchronous 1145 // - namelist vs. list 1146 // - external vs. internal + default KIND vs. internal + other KIND 1147 //===----------------------------------------------------------------------===// 1148 1149 // Determine the correct BeginXyz{In|Out}put api to invoke. 1150 template <bool isInput> 1151 mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder, 1152 bool isFormatted, bool isList, bool isIntern, 1153 bool isOtherIntern, bool isAsynch, 1154 bool isNml) { 1155 if constexpr (isInput) { 1156 if (isAsynch) 1157 return getIORuntimeFunc<mkIOKey(BeginAsynchronousInput)>(loc, builder); 1158 if (isFormatted) { 1159 if (isIntern) { 1160 if (isOtherIntern) { 1161 if (isList || isNml) 1162 return getIORuntimeFunc<mkIOKey(BeginInternalArrayListInput)>( 1163 loc, builder); 1164 return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedInput)>( 1165 loc, builder); 1166 } 1167 if (isList || isNml) 1168 return getIORuntimeFunc<mkIOKey(BeginInternalListInput)>(loc, 1169 builder); 1170 return getIORuntimeFunc<mkIOKey(BeginInternalFormattedInput)>(loc, 1171 builder); 1172 } 1173 if (isList || isNml) 1174 return getIORuntimeFunc<mkIOKey(BeginExternalListInput)>(loc, builder); 1175 return getIORuntimeFunc<mkIOKey(BeginExternalFormattedInput)>(loc, 1176 builder); 1177 } 1178 return getIORuntimeFunc<mkIOKey(BeginUnformattedInput)>(loc, builder); 1179 } else { 1180 if (isAsynch) 1181 return getIORuntimeFunc<mkIOKey(BeginAsynchronousOutput)>(loc, builder); 1182 if (isFormatted) { 1183 if (isIntern) { 1184 if (isOtherIntern) { 1185 if (isList || isNml) 1186 return getIORuntimeFunc<mkIOKey(BeginInternalArrayListOutput)>( 1187 loc, builder); 1188 return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedOutput)>( 1189 loc, builder); 1190 } 1191 if (isList || isNml) 1192 return getIORuntimeFunc<mkIOKey(BeginInternalListOutput)>(loc, 1193 builder); 1194 return getIORuntimeFunc<mkIOKey(BeginInternalFormattedOutput)>(loc, 1195 builder); 1196 } 1197 if (isList || isNml) 1198 return getIORuntimeFunc<mkIOKey(BeginExternalListOutput)>(loc, builder); 1199 return getIORuntimeFunc<mkIOKey(BeginExternalFormattedOutput)>(loc, 1200 builder); 1201 } 1202 return getIORuntimeFunc<mkIOKey(BeginUnformattedOutput)>(loc, builder); 1203 } 1204 } 1205 1206 /// Generate the arguments of a BeginXyz call. 1207 template <bool hasIOCtrl, typename A> 1208 void genBeginCallArguments(llvm::SmallVector<mlir::Value, 8> &ioArgs, 1209 Fortran::lower::AbstractConverter &converter, 1210 mlir::Location loc, const A &stmt, 1211 mlir::FunctionType ioFuncTy, bool isFormatted, 1212 bool isList, bool isIntern, bool isOtherIntern, 1213 bool isAsynch, bool isNml, 1214 Fortran::lower::pft::LabelEvalMap &labelMap, 1215 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1216 auto &builder = converter.getFirOpBuilder(); 1217 if constexpr (hasIOCtrl) { 1218 // READ/WRITE cases have a wide variety of argument permutations 1219 if (isAsynch || !isFormatted) { 1220 // unit (always first), ... 1221 ioArgs.push_back( 1222 getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); 1223 if (isAsynch) { 1224 // unknown-thingy, [buff, LEN] 1225 llvm_unreachable("not implemented"); 1226 } 1227 return; 1228 } 1229 assert(isFormatted && "formatted data transfer"); 1230 if (!isIntern) { 1231 if (isNml) { 1232 // namelist group, ... 1233 llvm_unreachable("not implemented"); 1234 } else if (!isList) { 1235 // | [format, LEN], ... 1236 auto pair = getFormat( 1237 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1238 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1239 ioArgs.push_back(std::get<0>(pair)); 1240 ioArgs.push_back(std::get<1>(pair)); 1241 } 1242 // unit (always last) 1243 ioArgs.push_back( 1244 getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); 1245 return; 1246 } 1247 assert(isIntern && "internal data transfer"); 1248 if (isNml || isOtherIntern) { 1249 // descriptor, ... 1250 ioArgs.push_back(getDescriptor(converter, loc, stmt, 1251 ioFuncTy.getInput(ioArgs.size()))); 1252 if (isNml) { 1253 // namelist group, ... 1254 llvm_unreachable("not implemented"); 1255 } else if (isOtherIntern && !isList) { 1256 // | [format, LEN], ... 1257 auto pair = getFormat( 1258 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1259 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1260 ioArgs.push_back(std::get<0>(pair)); 1261 ioArgs.push_back(std::get<1>(pair)); 1262 } 1263 } else { 1264 // | [buff, LEN], ... 1265 auto pair = 1266 getBuffer(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1267 ioFuncTy.getInput(ioArgs.size() + 1)); 1268 ioArgs.push_back(std::get<0>(pair)); 1269 ioArgs.push_back(std::get<1>(pair)); 1270 if (!isList) { 1271 // [format, LEN], ... 1272 auto pair = getFormat( 1273 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1274 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1275 ioArgs.push_back(std::get<0>(pair)); 1276 ioArgs.push_back(std::get<1>(pair)); 1277 } 1278 } 1279 // [scratch, LEN] (always last) 1280 ioArgs.push_back( 1281 getDefaultScratch(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1282 ioArgs.push_back( 1283 getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1284 } else { 1285 if (!isList) { 1286 // [format, LEN], ... 1287 auto pair = 1288 getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1289 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1290 ioArgs.push_back(std::get<0>(pair)); 1291 ioArgs.push_back(std::get<1>(pair)); 1292 } 1293 // unit (always last) 1294 ioArgs.push_back(builder.create<mlir::ConstantOp>( 1295 loc, builder.getIntegerAttr(ioFuncTy.getInput(ioArgs.size()), 1296 Fortran::runtime::io::DefaultUnit))); 1297 } 1298 } 1299 1300 template <bool isInput, bool hasIOCtrl = true, typename A> 1301 static mlir::Value 1302 genDataTransferStmt(Fortran::lower::AbstractConverter &converter, const A &stmt, 1303 Fortran::lower::pft::LabelEvalMap &labelMap, 1304 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1305 auto &builder = converter.getFirOpBuilder(); 1306 auto loc = converter.getCurrentLocation(); 1307 const bool isFormatted = isDataTransferFormatted(stmt); 1308 const bool isList = isFormatted ? isDataTransferList(stmt) : false; 1309 const bool isIntern = isDataTransferInternal(stmt); 1310 const bool isOtherIntern = 1311 isIntern ? isDataTransferInternalNotDefaultKind(stmt) : false; 1312 const bool isAsynch = isDataTransferAsynchronous(stmt); 1313 const bool isNml = isDataTransferNamelist(stmt); 1314 1315 // Determine which BeginXyz call to make. 1316 mlir::FuncOp ioFunc = 1317 getBeginDataTransfer<isInput>(loc, builder, isFormatted, isList, isIntern, 1318 isOtherIntern, isAsynch, isNml); 1319 mlir::FunctionType ioFuncTy = ioFunc.getType(); 1320 1321 // Append BeginXyz call arguments. File name and line number are always last. 1322 llvm::SmallVector<mlir::Value, 8> ioArgs; 1323 genBeginCallArguments<hasIOCtrl>(ioArgs, converter, loc, stmt, ioFuncTy, 1324 isFormatted, isList, isIntern, isOtherIntern, 1325 isAsynch, isNml, labelMap, assignMap); 1326 ioArgs.push_back( 1327 getDefaultFilename(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1328 ioArgs.push_back( 1329 getDefaultLineNo(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1330 1331 // Arguments are done; call the BeginXyz function. 1332 mlir::Value cookie = 1333 builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 1334 1335 // Generate an EnableHandlers call and remaining specifier calls. 1336 ConditionSpecifierInfo csi; 1337 mlir::OpBuilder::InsertPoint insertPt; 1338 mlir::Value ok; 1339 if constexpr (hasIOCtrl) { 1340 genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi); 1341 insertPt = threadSpecs(converter, loc, cookie, stmt.controls, 1342 csi.hasErrorConditionSpecifier(), ok); 1343 } 1344 1345 // Generate data transfer list calls. 1346 if constexpr (isInput) // ReadStmt 1347 genInputItemList(converter, cookie, stmt.items, insertPt, 1348 csi.hasTransferConditionSpecifier(), ok, false); 1349 else if constexpr (std::is_same_v<A, Fortran::parser::PrintStmt>) 1350 genOutputItemList(converter, cookie, std::get<1>(stmt.t), insertPt, 1351 csi.hasTransferConditionSpecifier(), ok, false); 1352 else // WriteStmt 1353 genOutputItemList(converter, cookie, stmt.items, insertPt, 1354 csi.hasTransferConditionSpecifier(), ok, false); 1355 1356 // Generate end statement call/s. 1357 if (insertPt.isSet()) 1358 builder.restoreInsertionPoint(insertPt); 1359 return genEndIO(converter, loc, cookie, csi); 1360 } 1361 1362 void Fortran::lower::genPrintStatement( 1363 Fortran::lower::AbstractConverter &converter, 1364 const Fortran::parser::PrintStmt &stmt, 1365 Fortran::lower::pft::LabelEvalMap &labelMap, 1366 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1367 // PRINT does not take an io-control-spec. It only has a format specifier, so 1368 // it is a simplified case of WRITE. 1369 genDataTransferStmt</*isInput=*/false, /*ioCtrl=*/false>(converter, stmt, 1370 labelMap, assignMap); 1371 } 1372 1373 mlir::Value Fortran::lower::genWriteStatement( 1374 Fortran::lower::AbstractConverter &converter, 1375 const Fortran::parser::WriteStmt &stmt, 1376 Fortran::lower::pft::LabelEvalMap &labelMap, 1377 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1378 return genDataTransferStmt</*isInput=*/false>(converter, stmt, labelMap, 1379 assignMap); 1380 } 1381 1382 mlir::Value Fortran::lower::genReadStatement( 1383 Fortran::lower::AbstractConverter &converter, 1384 const Fortran::parser::ReadStmt &stmt, 1385 Fortran::lower::pft::LabelEvalMap &labelMap, 1386 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1387 return genDataTransferStmt</*isInput=*/true>(converter, stmt, labelMap, 1388 assignMap); 1389 } 1390 1391 /// Get the file expression from the inquire spec list. Also return if the 1392 /// expression is a file name. 1393 static std::pair<const Fortran::semantics::SomeExpr *, bool> 1394 getInquireFileExpr(const std::list<Fortran::parser::InquireSpec> *stmt) { 1395 if (!stmt) 1396 return {nullptr, false}; 1397 for (const auto &spec : *stmt) { 1398 if (auto *f = std::get_if<Fortran::parser::FileUnitNumber>(&spec.u)) 1399 return {Fortran::semantics::GetExpr(*f), false}; 1400 if (auto *f = std::get_if<Fortran::parser::FileNameExpr>(&spec.u)) 1401 return {Fortran::semantics::GetExpr(*f), true}; 1402 } 1403 // semantics should have already caught this condition 1404 llvm_unreachable("inquire spec must have a file"); 1405 } 1406 1407 mlir::Value Fortran::lower::genInquireStatement( 1408 Fortran::lower::AbstractConverter &converter, 1409 const Fortran::parser::InquireStmt &stmt) { 1410 auto &builder = converter.getFirOpBuilder(); 1411 auto loc = converter.getCurrentLocation(); 1412 mlir::FuncOp beginFunc; 1413 mlir::Value cookie; 1414 ConditionSpecifierInfo csi{}; 1415 const auto *list = 1416 std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u); 1417 auto exprPair = getInquireFileExpr(list); 1418 auto inquireFileUnit = [&]() -> bool { 1419 return exprPair.first && !exprPair.second; 1420 }; 1421 auto inquireFileName = [&]() -> bool { 1422 return exprPair.first && exprPair.second; 1423 }; 1424 1425 // Determine which BeginInquire call to make. 1426 if (inquireFileUnit()) { 1427 // File unit call. 1428 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireUnit)>(loc, builder); 1429 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1430 auto unit = converter.genExprValue(exprPair.first, loc); 1431 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1432 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); 1433 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); 1434 llvm::SmallVector<mlir::Value, 4> beginArgs{un, file, line}; 1435 cookie = 1436 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1437 // Handle remaining arguments in specifier list. 1438 genConditionHandlerCall(converter, loc, cookie, *list, csi); 1439 } else if (inquireFileName()) { 1440 // Filename call. 1441 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireFile)>(loc, builder); 1442 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1443 auto file = converter.genExprValue(exprPair.first, loc); 1444 // Helper to query [BUFFER, LEN]. 1445 Fortran::lower::CharacterExprHelper helper(builder, loc); 1446 auto dataLen = helper.materializeCharacter(file); 1447 auto buff = 1448 builder.createConvert(loc, beginFuncTy.getInput(0), dataLen.first); 1449 auto len = 1450 builder.createConvert(loc, beginFuncTy.getInput(1), dataLen.second); 1451 auto kindInt = helper.getCharacterKind(file.getType()); 1452 mlir::Value kindValue = 1453 builder.createIntegerConstant(loc, beginFuncTy.getInput(2), kindInt); 1454 auto sourceFile = getDefaultFilename(builder, loc, beginFuncTy.getInput(3)); 1455 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(4)); 1456 llvm::SmallVector<mlir::Value, 5> beginArgs = { 1457 buff, len, kindValue, sourceFile, line, 1458 }; 1459 cookie = 1460 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1461 // Handle remaining arguments in specifier list. 1462 genConditionHandlerCall(converter, loc, cookie, *list, csi); 1463 } else { 1464 // Io length call. 1465 const auto *ioLength = 1466 std::get_if<Fortran::parser::InquireStmt::Iolength>(&stmt.u); 1467 assert(ioLength && "must have an io length"); 1468 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireIoLength)>(loc, builder); 1469 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1470 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(0)); 1471 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(1)); 1472 llvm::SmallVector<mlir::Value, 4> beginArgs{file, line}; 1473 cookie = 1474 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1475 // Handle remaining arguments in output list. 1476 genConditionHandlerCall( 1477 converter, loc, cookie, 1478 std::get<std::list<Fortran::parser::OutputItem>>(ioLength->t), csi); 1479 } 1480 // Generate end statement call. 1481 return genEndIO(converter, loc, cookie, csi); 1482 } 1483