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