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