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