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(SetEncoding), mkIOKey(SetForm), mkIOKey(SetPosition), 64 mkIOKey(SetRecl), mkIOKey(SetStatus), mkIOKey(SetFile), mkIOKey(GetNewUnit), 65 mkIOKey(GetSize), mkIOKey(GetIoLength), mkIOKey(GetIoMsg), 66 mkIOKey(InquireCharacter), mkIOKey(InquireLogical), 67 mkIOKey(InquirePendingId), mkIOKey(InquireInteger64), 68 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::Convert: 603 llvm_unreachable("CONVERT not part of the runtime::io interface"); 604 case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose: 605 llvm_unreachable("DISPOSE not part of the runtime::io interface"); 606 } 607 mlir::FunctionType ioFuncTy = ioFunc.getType(); 608 auto tup = lowerStringLit( 609 converter, loc, std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t), 610 ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 611 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, std::get<0>(tup), 612 std::get<1>(tup)}; 613 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 614 } 615 616 template <> 617 mlir::Value genIOOption<Fortran::parser::ConnectSpec::Recl>( 618 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 619 mlir::Value cookie, const Fortran::parser::ConnectSpec::Recl &spec) { 620 return genIntIOOption<mkIOKey(SetRecl)>(converter, loc, cookie, spec); 621 } 622 623 template <> 624 mlir::Value genIOOption<Fortran::parser::StatusExpr>( 625 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 626 mlir::Value cookie, const Fortran::parser::StatusExpr &spec) { 627 return genCharIOOption<mkIOKey(SetStatus)>(converter, loc, cookie, spec.v); 628 } 629 630 template <> 631 mlir::Value 632 genIOOption<Fortran::parser::Name>(Fortran::lower::AbstractConverter &converter, 633 mlir::Location loc, mlir::Value cookie, 634 const Fortran::parser::Name &spec) { 635 // namelist 636 llvm_unreachable("not implemented"); 637 } 638 639 template <> 640 mlir::Value genIOOption<Fortran::parser::IoControlSpec::CharExpr>( 641 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 642 mlir::Value cookie, const Fortran::parser::IoControlSpec::CharExpr &spec) { 643 auto &builder = converter.getFirOpBuilder(); 644 mlir::FuncOp ioFunc; 645 switch (std::get<Fortran::parser::IoControlSpec::CharExpr::Kind>(spec.t)) { 646 case Fortran::parser::IoControlSpec::CharExpr::Kind::Advance: 647 ioFunc = getIORuntimeFunc<mkIOKey(SetAdvance)>(loc, builder); 648 break; 649 case Fortran::parser::IoControlSpec::CharExpr::Kind::Blank: 650 ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder); 651 break; 652 case Fortran::parser::IoControlSpec::CharExpr::Kind::Decimal: 653 ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder); 654 break; 655 case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim: 656 ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder); 657 break; 658 case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad: 659 ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder); 660 break; 661 case Fortran::parser::IoControlSpec::CharExpr::Kind::Round: 662 ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder); 663 break; 664 case Fortran::parser::IoControlSpec::CharExpr::Kind::Sign: 665 ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder); 666 break; 667 } 668 mlir::FunctionType ioFuncTy = ioFunc.getType(); 669 auto tup = lowerStringLit( 670 converter, loc, std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t), 671 ioFuncTy.getInput(1), ioFuncTy.getInput(2)); 672 llvm::SmallVector<mlir::Value, 4> ioArgs = {cookie, std::get<0>(tup), 673 std::get<1>(tup)}; 674 return builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 675 } 676 677 template <> 678 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Asynchronous>( 679 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 680 mlir::Value cookie, 681 const Fortran::parser::IoControlSpec::Asynchronous &spec) { 682 return genCharIOOption<mkIOKey(SetAsynchronous)>(converter, loc, cookie, 683 spec.v); 684 } 685 686 template <> 687 mlir::Value genIOOption<Fortran::parser::IdVariable>( 688 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 689 mlir::Value cookie, const Fortran::parser::IdVariable &spec) { 690 llvm_unreachable("asynchronous ID not implemented"); 691 } 692 693 template <> 694 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Pos>( 695 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 696 mlir::Value cookie, const Fortran::parser::IoControlSpec::Pos &spec) { 697 return genIntIOOption<mkIOKey(SetPos)>(converter, loc, cookie, spec); 698 } 699 template <> 700 mlir::Value genIOOption<Fortran::parser::IoControlSpec::Rec>( 701 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 702 mlir::Value cookie, const Fortran::parser::IoControlSpec::Rec &spec) { 703 return genIntIOOption<mkIOKey(SetRec)>(converter, loc, cookie, spec); 704 } 705 706 //===----------------------------------------------------------------------===// 707 // Gather I/O statement condition specifier information (if any). 708 //===----------------------------------------------------------------------===// 709 710 template <typename SEEK, typename A> 711 static bool hasX(const A &list) { 712 for (const auto &spec : list) 713 if (std::holds_alternative<SEEK>(spec.u)) 714 return true; 715 return false; 716 } 717 718 template <typename SEEK, typename A> 719 static bool hasMem(const A &stmt) { 720 return hasX<SEEK>(stmt.v); 721 } 722 723 /// Get the sought expression from the specifier list. 724 template <typename SEEK, typename A> 725 static const Fortran::semantics::SomeExpr *getExpr(const A &stmt) { 726 for (const auto &spec : stmt.v) 727 if (auto *f = std::get_if<SEEK>(&spec.u)) 728 return Fortran::semantics::GetExpr(f->v); 729 llvm_unreachable("must have a file unit"); 730 } 731 732 /// For each specifier, build the appropriate call, threading the cookie, and 733 /// returning the insertion point as to the initial context. If there are no 734 /// specifiers, the insertion point is undefined. 735 template <typename A> 736 static mlir::OpBuilder::InsertPoint 737 threadSpecs(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 738 mlir::Value cookie, const A &specList, bool checkResult, 739 mlir::Value &ok) { 740 auto &builder = converter.getFirOpBuilder(); 741 mlir::OpBuilder::InsertPoint insertPt; 742 for (const auto &spec : specList) { 743 makeNextConditionalOn(builder, loc, insertPt, checkResult, ok); 744 ok = std::visit(Fortran::common::visitors{[&](const auto &x) { 745 return genIOOption(converter, loc, cookie, x); 746 }}, 747 spec.u); 748 } 749 return insertPt; 750 } 751 752 template <typename A> 753 static void 754 genConditionHandlerCall(Fortran::lower::AbstractConverter &converter, 755 mlir::Location loc, mlir::Value cookie, 756 const A &specList, ConditionSpecifierInfo &csi) { 757 for (const auto &spec : specList) { 758 std::visit( 759 Fortran::common::visitors{ 760 [&](const Fortran::parser::StatVariable &msgVar) { 761 csi.ioStatExpr = Fortran::semantics::GetExpr(msgVar); 762 }, 763 [&](const Fortran::parser::MsgVariable &msgVar) { 764 csi.ioMsgExpr = Fortran::semantics::GetExpr(msgVar); 765 }, 766 [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; }, 767 [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; }, 768 [&](const Fortran::parser::ErrLabel &) { csi.hasErr = true; }, 769 [](const auto &) {}}, 770 spec.u); 771 } 772 if (!csi.hasAnyConditionSpecifier()) 773 return; 774 auto &builder = converter.getFirOpBuilder(); 775 mlir::FuncOp enableHandlers = 776 getIORuntimeFunc<mkIOKey(EnableHandlers)>(loc, builder); 777 mlir::Type boolType = enableHandlers.getType().getInput(1); 778 auto boolValue = [&](bool specifierIsPresent) { 779 return builder.create<mlir::ConstantOp>( 780 loc, builder.getIntegerAttr(boolType, specifierIsPresent)); 781 }; 782 llvm::SmallVector<mlir::Value, 6> ioArgs = { 783 cookie, 784 boolValue(csi.ioStatExpr != nullptr), 785 boolValue(csi.hasErr), 786 boolValue(csi.hasEnd), 787 boolValue(csi.hasEor), 788 boolValue(csi.ioMsgExpr != nullptr)}; 789 builder.create<mlir::CallOp>(loc, enableHandlers, ioArgs); 790 } 791 792 //===----------------------------------------------------------------------===// 793 // Data transfer helpers 794 //===----------------------------------------------------------------------===// 795 796 template <typename SEEK, typename A> 797 static bool hasIOControl(const A &stmt) { 798 return hasX<SEEK>(stmt.controls); 799 } 800 801 template <typename SEEK, typename A> 802 static const auto *getIOControl(const A &stmt) { 803 for (const auto &spec : stmt.controls) 804 if (const auto *result = std::get_if<SEEK>(&spec.u)) 805 return result; 806 return static_cast<const SEEK *>(nullptr); 807 } 808 809 /// returns true iff the expression in the parse tree is not really a format but 810 /// rather a namelist variable. 811 template <typename A> 812 static bool formatIsActuallyNamelist(const A &format) { 813 if (auto *e = std::get_if<Fortran::parser::Expr>(&format.u)) { 814 auto *expr = Fortran::semantics::GetExpr(*e); 815 if (const Fortran::semantics::Symbol *y = 816 Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) 817 return y->has<Fortran::semantics::NamelistDetails>(); 818 } 819 return false; 820 } 821 822 template <typename A> 823 static bool isDataTransferFormatted(const A &stmt) { 824 if (stmt.format) 825 return !formatIsActuallyNamelist(*stmt.format); 826 return hasIOControl<Fortran::parser::Format>(stmt); 827 } 828 template <> 829 constexpr bool isDataTransferFormatted<Fortran::parser::PrintStmt>( 830 const Fortran::parser::PrintStmt &) { 831 return true; // PRINT is always formatted 832 } 833 834 template <typename A> 835 static bool isDataTransferList(const A &stmt) { 836 if (stmt.format) 837 return std::holds_alternative<Fortran::parser::Star>(stmt.format->u); 838 if (auto *mem = getIOControl<Fortran::parser::Format>(stmt)) 839 return std::holds_alternative<Fortran::parser::Star>(mem->u); 840 return false; 841 } 842 template <> 843 bool isDataTransferList<Fortran::parser::PrintStmt>( 844 const Fortran::parser::PrintStmt &stmt) { 845 return std::holds_alternative<Fortran::parser::Star>( 846 std::get<Fortran::parser::Format>(stmt.t).u); 847 } 848 849 template <typename A> 850 static bool isDataTransferInternal(const A &stmt) { 851 if (stmt.iounit.has_value()) 852 return std::holds_alternative<Fortran::parser::Variable>(stmt.iounit->u); 853 if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt)) 854 return std::holds_alternative<Fortran::parser::Variable>(unit->u); 855 return false; 856 } 857 template <> 858 constexpr bool isDataTransferInternal<Fortran::parser::PrintStmt>( 859 const Fortran::parser::PrintStmt &) { 860 return false; 861 } 862 863 static bool hasNonDefaultCharKind(const Fortran::parser::Variable &var) { 864 // TODO 865 return false; 866 } 867 868 template <typename A> 869 static bool isDataTransferInternalNotDefaultKind(const A &stmt) { 870 // same as isDataTransferInternal, but the KIND of the expression is not the 871 // default KIND. 872 if (stmt.iounit.has_value()) 873 if (auto *var = std::get_if<Fortran::parser::Variable>(&stmt.iounit->u)) 874 return hasNonDefaultCharKind(*var); 875 if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt)) 876 if (auto *var = std::get_if<Fortran::parser::Variable>(&unit->u)) 877 return hasNonDefaultCharKind(*var); 878 return false; 879 } 880 template <> 881 constexpr bool isDataTransferInternalNotDefaultKind<Fortran::parser::PrintStmt>( 882 const Fortran::parser::PrintStmt &) { 883 return false; 884 } 885 886 template <typename A> 887 static bool isDataTransferAsynchronous(const A &stmt) { 888 if (auto *asynch = 889 getIOControl<Fortran::parser::IoControlSpec::Asynchronous>(stmt)) { 890 // FIXME: should contain a string of YES or NO 891 llvm_unreachable("asynchronous transfers not implemented in runtime"); 892 } 893 return false; 894 } 895 template <> 896 constexpr bool isDataTransferAsynchronous<Fortran::parser::PrintStmt>( 897 const Fortran::parser::PrintStmt &) { 898 return false; 899 } 900 901 template <typename A> 902 static bool isDataTransferNamelist(const A &stmt) { 903 if (stmt.format) 904 return formatIsActuallyNamelist(*stmt.format); 905 return hasIOControl<Fortran::parser::Name>(stmt); 906 } 907 template <> 908 constexpr bool isDataTransferNamelist<Fortran::parser::PrintStmt>( 909 const Fortran::parser::PrintStmt &) { 910 return false; 911 } 912 913 /// Generate a reference to a format string. There are four cases - a format 914 /// statement label, a character format expression, an integer that holds the 915 /// label of a format statement, and the * case. The first three are done here. 916 /// The * case is done elsewhere. 917 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 918 genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 919 const Fortran::parser::Format &format, mlir::Type strTy, 920 mlir::Type lenTy, Fortran::lower::pft::LabelEvalMap &labelMap, 921 Fortran::lower::pft::SymbolLabelMap &assignMap) { 922 if (const auto *label = std::get_if<Fortran::parser::Label>(&format.u)) { 923 // format statement label 924 auto iter = labelMap.find(*label); 925 assert(iter != labelMap.end() && "FORMAT not found in PROCEDURE"); 926 return lowerSourceTextAsStringLit( 927 converter, loc, toStringRef(iter->second->position), strTy, lenTy); 928 } 929 const auto *pExpr = std::get_if<Fortran::parser::Expr>(&format.u); 930 assert(pExpr && "missing format expression"); 931 auto e = Fortran::semantics::GetExpr(*pExpr); 932 if (Fortran::semantics::ExprHasTypeCategory( 933 *e, Fortran::common::TypeCategory::Character)) 934 // character expression 935 return lowerStringLit(converter, loc, *pExpr, strTy, lenTy); 936 // integer variable containing an ASSIGN label 937 assert(Fortran::semantics::ExprHasTypeCategory( 938 *e, Fortran::common::TypeCategory::Integer)); 939 // TODO - implement this 940 llvm::report_fatal_error( 941 "using a variable to reference a FORMAT statement; not implemented yet"); 942 } 943 944 template <typename A> 945 std::tuple<mlir::Value, mlir::Value, mlir::Value> 946 getFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 947 const A &stmt, mlir::Type strTy, mlir::Type lenTy, 948 Fortran::lower::pft::LabelEvalMap &labelMap, 949 Fortran::lower::pft::SymbolLabelMap &assignMap) { 950 if (stmt.format && !formatIsActuallyNamelist(*stmt.format)) 951 return genFormat(converter, loc, *stmt.format, strTy, lenTy, labelMap, 952 assignMap); 953 return genFormat(converter, loc, *getIOControl<Fortran::parser::Format>(stmt), 954 strTy, lenTy, labelMap, assignMap); 955 } 956 template <> 957 std::tuple<mlir::Value, mlir::Value, mlir::Value> 958 getFormat<Fortran::parser::PrintStmt>( 959 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 960 const Fortran::parser::PrintStmt &stmt, mlir::Type strTy, mlir::Type lenTy, 961 Fortran::lower::pft::LabelEvalMap &labelMap, 962 Fortran::lower::pft::SymbolLabelMap &assignMap) { 963 return genFormat(converter, loc, std::get<Fortran::parser::Format>(stmt.t), 964 strTy, lenTy, labelMap, assignMap); 965 } 966 967 static std::tuple<mlir::Value, mlir::Value, mlir::Value> 968 genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 969 const Fortran::parser::IoUnit &iounit, mlir::Type strTy, 970 mlir::Type lenTy) { 971 [[maybe_unused]] auto &var = std::get<Fortran::parser::Variable>(iounit.u); 972 TODO(); 973 } 974 template <typename A> 975 std::tuple<mlir::Value, mlir::Value, mlir::Value> 976 getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, 977 const A &stmt, mlir::Type strTy, mlir::Type lenTy) { 978 if (stmt.iounit) 979 return genBuffer(converter, loc, *stmt.iounit, strTy, lenTy); 980 return genBuffer(converter, loc, *getIOControl<Fortran::parser::IoUnit>(stmt), 981 strTy, lenTy); 982 } 983 984 template <typename A> 985 mlir::Value getDescriptor(Fortran::lower::AbstractConverter &converter, 986 mlir::Location loc, const A &stmt, 987 mlir::Type toType) { 988 TODO(); 989 } 990 991 static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter, 992 mlir::Location loc, 993 const Fortran::parser::IoUnit &iounit, 994 mlir::Type ty) { 995 auto &builder = converter.getFirOpBuilder(); 996 if (auto *e = std::get_if<Fortran::parser::FileUnitNumber>(&iounit.u)) { 997 auto ex = converter.genExprValue(Fortran::semantics::GetExpr(*e), loc); 998 return builder.createConvert(loc, ty, ex); 999 } 1000 return builder.create<mlir::ConstantOp>( 1001 loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit)); 1002 } 1003 1004 template <typename A> 1005 mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter, 1006 mlir::Location loc, const A &stmt, mlir::Type ty) { 1007 if (stmt.iounit) 1008 return genIOUnit(converter, loc, *stmt.iounit, ty); 1009 return genIOUnit(converter, loc, *getIOControl<Fortran::parser::IoUnit>(stmt), 1010 ty); 1011 } 1012 1013 //===----------------------------------------------------------------------===// 1014 // Generators for each I/O statement type. 1015 //===----------------------------------------------------------------------===// 1016 1017 template <typename K, typename S> 1018 static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter, 1019 const S &stmt) { 1020 auto &builder = converter.getFirOpBuilder(); 1021 auto loc = converter.getCurrentLocation(); 1022 auto beginFunc = getIORuntimeFunc<K>(loc, builder); 1023 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1024 auto unit = converter.genExprValue( 1025 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1026 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1027 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); 1028 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); 1029 llvm::SmallVector<mlir::Value, 4> args{un, file, line}; 1030 auto cookie = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0); 1031 ConditionSpecifierInfo csi{}; 1032 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1033 mlir::Value ok{}; 1034 auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, 1035 csi.hasErrorConditionSpecifier(), ok); 1036 if (insertPt.isSet()) 1037 builder.restoreInsertionPoint(insertPt); 1038 return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); 1039 } 1040 1041 mlir::Value Fortran::lower::genBackspaceStatement( 1042 Fortran::lower::AbstractConverter &converter, 1043 const Fortran::parser::BackspaceStmt &stmt) { 1044 return genBasicIOStmt<mkIOKey(BeginBackspace)>(converter, stmt); 1045 } 1046 1047 mlir::Value Fortran::lower::genEndfileStatement( 1048 Fortran::lower::AbstractConverter &converter, 1049 const Fortran::parser::EndfileStmt &stmt) { 1050 return genBasicIOStmt<mkIOKey(BeginEndfile)>(converter, stmt); 1051 } 1052 1053 mlir::Value 1054 Fortran::lower::genFlushStatement(Fortran::lower::AbstractConverter &converter, 1055 const Fortran::parser::FlushStmt &stmt) { 1056 return genBasicIOStmt<mkIOKey(BeginFlush)>(converter, stmt); 1057 } 1058 1059 mlir::Value 1060 Fortran::lower::genRewindStatement(Fortran::lower::AbstractConverter &converter, 1061 const Fortran::parser::RewindStmt &stmt) { 1062 return genBasicIOStmt<mkIOKey(BeginRewind)>(converter, stmt); 1063 } 1064 1065 mlir::Value 1066 Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter, 1067 const Fortran::parser::OpenStmt &stmt) { 1068 auto &builder = converter.getFirOpBuilder(); 1069 mlir::FuncOp beginFunc; 1070 llvm::SmallVector<mlir::Value, 4> beginArgs; 1071 auto loc = converter.getCurrentLocation(); 1072 if (hasMem<Fortran::parser::FileUnitNumber>(stmt)) { 1073 beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenUnit)>(loc, builder); 1074 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1075 auto unit = converter.genExprValue( 1076 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1077 beginArgs.push_back( 1078 builder.createConvert(loc, beginFuncTy.getInput(0), unit)); 1079 beginArgs.push_back( 1080 getDefaultFilename(builder, loc, beginFuncTy.getInput(1))); 1081 beginArgs.push_back( 1082 getDefaultLineNo(builder, loc, beginFuncTy.getInput(2))); 1083 } else { 1084 assert(hasMem<Fortran::parser::ConnectSpec::Newunit>(stmt)); 1085 beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenNewUnit)>(loc, builder); 1086 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1087 beginArgs.push_back( 1088 getDefaultFilename(builder, loc, beginFuncTy.getInput(0))); 1089 beginArgs.push_back( 1090 getDefaultLineNo(builder, loc, beginFuncTy.getInput(1))); 1091 } 1092 auto cookie = 1093 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1094 ConditionSpecifierInfo csi{}; 1095 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1096 mlir::Value ok{}; 1097 auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, 1098 csi.hasErrorConditionSpecifier(), ok); 1099 if (insertPt.isSet()) 1100 builder.restoreInsertionPoint(insertPt); 1101 return genEndIO(converter, loc, cookie, csi); 1102 } 1103 1104 mlir::Value 1105 Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter &converter, 1106 const Fortran::parser::CloseStmt &stmt) { 1107 return genBasicIOStmt<mkIOKey(BeginClose)>(converter, stmt); 1108 } 1109 1110 mlir::Value 1111 Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter, 1112 const Fortran::parser::WaitStmt &stmt) { 1113 auto &builder = converter.getFirOpBuilder(); 1114 auto loc = converter.getCurrentLocation(); 1115 bool hasId = hasMem<Fortran::parser::IdExpr>(stmt); 1116 mlir::FuncOp beginFunc = 1117 hasId ? getIORuntimeFunc<mkIOKey(BeginWait)>(loc, builder) 1118 : getIORuntimeFunc<mkIOKey(BeginWaitAll)>(loc, builder); 1119 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1120 auto unit = converter.genExprValue( 1121 getExpr<Fortran::parser::FileUnitNumber>(stmt), loc); 1122 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1123 llvm::SmallVector<mlir::Value, 4> args{un}; 1124 if (hasId) { 1125 auto id = 1126 converter.genExprValue(getExpr<Fortran::parser::IdExpr>(stmt), loc); 1127 args.push_back(builder.createConvert(loc, beginFuncTy.getInput(1), id)); 1128 } 1129 auto cookie = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0); 1130 ConditionSpecifierInfo csi{}; 1131 genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); 1132 return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); 1133 } 1134 1135 //===----------------------------------------------------------------------===// 1136 // Data transfer statements. 1137 // 1138 // There are several dimensions to the API with regard to data transfer 1139 // statements that need to be considered. 1140 // 1141 // - input (READ) vs. output (WRITE, PRINT) 1142 // - formatted vs. list vs. unformatted 1143 // - synchronous vs. asynchronous 1144 // - namelist vs. list 1145 // - external vs. internal + default KIND vs. internal + other KIND 1146 //===----------------------------------------------------------------------===// 1147 1148 // Determine the correct BeginXyz{In|Out}put api to invoke. 1149 template <bool isInput> 1150 mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder, 1151 bool isFormatted, bool isList, bool isIntern, 1152 bool isOtherIntern, bool isAsynch, 1153 bool isNml) { 1154 if constexpr (isInput) { 1155 if (isAsynch) 1156 return getIORuntimeFunc<mkIOKey(BeginAsynchronousInput)>(loc, builder); 1157 if (isFormatted) { 1158 if (isIntern) { 1159 if (isNml) 1160 return getIORuntimeFunc<mkIOKey(BeginInternalNamelistInput)>(loc, 1161 builder); 1162 if (isOtherIntern) { 1163 if (isList) 1164 return getIORuntimeFunc<mkIOKey(BeginInternalArrayListInput)>( 1165 loc, builder); 1166 return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedInput)>( 1167 loc, builder); 1168 } 1169 if (isList) 1170 return getIORuntimeFunc<mkIOKey(BeginInternalListInput)>(loc, 1171 builder); 1172 return getIORuntimeFunc<mkIOKey(BeginInternalFormattedInput)>(loc, 1173 builder); 1174 } 1175 if (isNml) 1176 return getIORuntimeFunc<mkIOKey(BeginExternalNamelistInput)>(loc, 1177 builder); 1178 if (isList) 1179 return getIORuntimeFunc<mkIOKey(BeginExternalListInput)>(loc, builder); 1180 return getIORuntimeFunc<mkIOKey(BeginExternalFormattedInput)>(loc, 1181 builder); 1182 } 1183 return getIORuntimeFunc<mkIOKey(BeginUnformattedInput)>(loc, builder); 1184 } else { 1185 if (isAsynch) 1186 return getIORuntimeFunc<mkIOKey(BeginAsynchronousOutput)>(loc, builder); 1187 if (isFormatted) { 1188 if (isIntern) { 1189 if (isNml) 1190 return getIORuntimeFunc<mkIOKey(BeginInternalNamelistOutput)>( 1191 loc, builder); 1192 if (isOtherIntern) { 1193 if (isList) 1194 return getIORuntimeFunc<mkIOKey(BeginInternalArrayListOutput)>( 1195 loc, builder); 1196 return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedOutput)>( 1197 loc, builder); 1198 } 1199 if (isList) 1200 return getIORuntimeFunc<mkIOKey(BeginInternalListOutput)>(loc, 1201 builder); 1202 return getIORuntimeFunc<mkIOKey(BeginInternalFormattedOutput)>(loc, 1203 builder); 1204 } 1205 if (isNml) 1206 return getIORuntimeFunc<mkIOKey(BeginExternalNamelistOutput)>(loc, 1207 builder); 1208 if (isList) 1209 return getIORuntimeFunc<mkIOKey(BeginExternalListOutput)>(loc, builder); 1210 return getIORuntimeFunc<mkIOKey(BeginExternalFormattedOutput)>(loc, 1211 builder); 1212 } 1213 return getIORuntimeFunc<mkIOKey(BeginUnformattedOutput)>(loc, builder); 1214 } 1215 } 1216 1217 /// Generate the arguments of a BeginXyz call. 1218 template <bool hasIOCtrl, typename A> 1219 void genBeginCallArguments(llvm::SmallVector<mlir::Value, 8> &ioArgs, 1220 Fortran::lower::AbstractConverter &converter, 1221 mlir::Location loc, const A &stmt, 1222 mlir::FunctionType ioFuncTy, bool isFormatted, 1223 bool isList, bool isIntern, bool isOtherIntern, 1224 bool isAsynch, bool isNml, 1225 Fortran::lower::pft::LabelEvalMap &labelMap, 1226 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1227 auto &builder = converter.getFirOpBuilder(); 1228 if constexpr (hasIOCtrl) { 1229 // READ/WRITE cases have a wide variety of argument permutations 1230 if (isAsynch || !isFormatted) { 1231 // unit (always first), ... 1232 ioArgs.push_back( 1233 getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); 1234 if (isAsynch) { 1235 // unknown-thingy, [buff, LEN] 1236 llvm_unreachable("not implemented"); 1237 } 1238 return; 1239 } 1240 assert(isFormatted && "formatted data transfer"); 1241 if (!isIntern) { 1242 if (isNml) { 1243 // namelist group, ... 1244 llvm_unreachable("not implemented"); 1245 } else if (!isList) { 1246 // | [format, LEN], ... 1247 auto pair = getFormat( 1248 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1249 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1250 ioArgs.push_back(std::get<0>(pair)); 1251 ioArgs.push_back(std::get<1>(pair)); 1252 } 1253 // unit (always last) 1254 ioArgs.push_back( 1255 getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); 1256 return; 1257 } 1258 assert(isIntern && "internal data transfer"); 1259 if (isNml || isOtherIntern) { 1260 // descriptor, ... 1261 ioArgs.push_back(getDescriptor(converter, loc, stmt, 1262 ioFuncTy.getInput(ioArgs.size()))); 1263 if (isNml) { 1264 // namelist group, ... 1265 llvm_unreachable("not implemented"); 1266 } else if (isOtherIntern && !isList) { 1267 // | [format, LEN], ... 1268 auto pair = getFormat( 1269 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1270 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1271 ioArgs.push_back(std::get<0>(pair)); 1272 ioArgs.push_back(std::get<1>(pair)); 1273 } 1274 } else { 1275 // | [buff, LEN], ... 1276 auto pair = 1277 getBuffer(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1278 ioFuncTy.getInput(ioArgs.size() + 1)); 1279 ioArgs.push_back(std::get<0>(pair)); 1280 ioArgs.push_back(std::get<1>(pair)); 1281 if (!isList) { 1282 // [format, LEN], ... 1283 auto pair = getFormat( 1284 converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1285 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1286 ioArgs.push_back(std::get<0>(pair)); 1287 ioArgs.push_back(std::get<1>(pair)); 1288 } 1289 } 1290 // [scratch, LEN] (always last) 1291 ioArgs.push_back( 1292 getDefaultScratch(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1293 ioArgs.push_back( 1294 getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1295 } else { 1296 if (!isList) { 1297 // [format, LEN], ... 1298 auto pair = 1299 getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), 1300 ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); 1301 ioArgs.push_back(std::get<0>(pair)); 1302 ioArgs.push_back(std::get<1>(pair)); 1303 } 1304 // unit (always last) 1305 ioArgs.push_back(builder.create<mlir::ConstantOp>( 1306 loc, builder.getIntegerAttr(ioFuncTy.getInput(ioArgs.size()), 1307 Fortran::runtime::io::DefaultUnit))); 1308 } 1309 } 1310 1311 template <bool isInput, bool hasIOCtrl = true, typename A> 1312 static mlir::Value 1313 genDataTransferStmt(Fortran::lower::AbstractConverter &converter, const A &stmt, 1314 Fortran::lower::pft::LabelEvalMap &labelMap, 1315 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1316 auto &builder = converter.getFirOpBuilder(); 1317 auto loc = converter.getCurrentLocation(); 1318 const bool isFormatted = isDataTransferFormatted(stmt); 1319 const bool isList = isFormatted ? isDataTransferList(stmt) : false; 1320 const bool isIntern = isDataTransferInternal(stmt); 1321 const bool isOtherIntern = 1322 isIntern ? isDataTransferInternalNotDefaultKind(stmt) : false; 1323 const bool isAsynch = isDataTransferAsynchronous(stmt); 1324 const bool isNml = isDataTransferNamelist(stmt); 1325 1326 // Determine which BeginXyz call to make. 1327 mlir::FuncOp ioFunc = 1328 getBeginDataTransfer<isInput>(loc, builder, isFormatted, isList, isIntern, 1329 isOtherIntern, isAsynch, isNml); 1330 mlir::FunctionType ioFuncTy = ioFunc.getType(); 1331 1332 // Append BeginXyz call arguments. File name and line number are always last. 1333 llvm::SmallVector<mlir::Value, 8> ioArgs; 1334 genBeginCallArguments<hasIOCtrl>(ioArgs, converter, loc, stmt, ioFuncTy, 1335 isFormatted, isList, isIntern, isOtherIntern, 1336 isAsynch, isNml, labelMap, assignMap); 1337 ioArgs.push_back( 1338 getDefaultFilename(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1339 ioArgs.push_back( 1340 getDefaultLineNo(builder, loc, ioFuncTy.getInput(ioArgs.size()))); 1341 1342 // Arguments are done; call the BeginXyz function. 1343 mlir::Value cookie = 1344 builder.create<mlir::CallOp>(loc, ioFunc, ioArgs).getResult(0); 1345 1346 // Generate an EnableHandlers call and remaining specifier calls. 1347 ConditionSpecifierInfo csi; 1348 mlir::OpBuilder::InsertPoint insertPt; 1349 mlir::Value ok; 1350 if constexpr (hasIOCtrl) { 1351 genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi); 1352 insertPt = threadSpecs(converter, loc, cookie, stmt.controls, 1353 csi.hasErrorConditionSpecifier(), ok); 1354 } 1355 1356 // Generate data transfer list calls. 1357 if constexpr (isInput) // ReadStmt 1358 genInputItemList(converter, cookie, stmt.items, insertPt, 1359 csi.hasTransferConditionSpecifier(), ok, false); 1360 else if constexpr (std::is_same_v<A, Fortran::parser::PrintStmt>) 1361 genOutputItemList(converter, cookie, std::get<1>(stmt.t), insertPt, 1362 csi.hasTransferConditionSpecifier(), ok, false); 1363 else // WriteStmt 1364 genOutputItemList(converter, cookie, stmt.items, insertPt, 1365 csi.hasTransferConditionSpecifier(), ok, false); 1366 1367 // Generate end statement call/s. 1368 if (insertPt.isSet()) 1369 builder.restoreInsertionPoint(insertPt); 1370 return genEndIO(converter, loc, cookie, csi); 1371 } 1372 1373 void Fortran::lower::genPrintStatement( 1374 Fortran::lower::AbstractConverter &converter, 1375 const Fortran::parser::PrintStmt &stmt, 1376 Fortran::lower::pft::LabelEvalMap &labelMap, 1377 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1378 // PRINT does not take an io-control-spec. It only has a format specifier, so 1379 // it is a simplified case of WRITE. 1380 genDataTransferStmt</*isInput=*/false, /*ioCtrl=*/false>(converter, stmt, 1381 labelMap, assignMap); 1382 } 1383 1384 mlir::Value Fortran::lower::genWriteStatement( 1385 Fortran::lower::AbstractConverter &converter, 1386 const Fortran::parser::WriteStmt &stmt, 1387 Fortran::lower::pft::LabelEvalMap &labelMap, 1388 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1389 return genDataTransferStmt</*isInput=*/false>(converter, stmt, labelMap, 1390 assignMap); 1391 } 1392 1393 mlir::Value Fortran::lower::genReadStatement( 1394 Fortran::lower::AbstractConverter &converter, 1395 const Fortran::parser::ReadStmt &stmt, 1396 Fortran::lower::pft::LabelEvalMap &labelMap, 1397 Fortran::lower::pft::SymbolLabelMap &assignMap) { 1398 return genDataTransferStmt</*isInput=*/true>(converter, stmt, labelMap, 1399 assignMap); 1400 } 1401 1402 /// Get the file expression from the inquire spec list. Also return if the 1403 /// expression is a file name. 1404 static std::pair<const Fortran::semantics::SomeExpr *, bool> 1405 getInquireFileExpr(const std::list<Fortran::parser::InquireSpec> *stmt) { 1406 if (!stmt) 1407 return {nullptr, false}; 1408 for (const auto &spec : *stmt) { 1409 if (auto *f = std::get_if<Fortran::parser::FileUnitNumber>(&spec.u)) 1410 return {Fortran::semantics::GetExpr(*f), false}; 1411 if (auto *f = std::get_if<Fortran::parser::FileNameExpr>(&spec.u)) 1412 return {Fortran::semantics::GetExpr(*f), true}; 1413 } 1414 // semantics should have already caught this condition 1415 llvm_unreachable("inquire spec must have a file"); 1416 } 1417 1418 mlir::Value Fortran::lower::genInquireStatement( 1419 Fortran::lower::AbstractConverter &converter, 1420 const Fortran::parser::InquireStmt &stmt) { 1421 auto &builder = converter.getFirOpBuilder(); 1422 auto loc = converter.getCurrentLocation(); 1423 mlir::FuncOp beginFunc; 1424 mlir::Value cookie; 1425 ConditionSpecifierInfo csi{}; 1426 const auto *list = 1427 std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u); 1428 auto exprPair = getInquireFileExpr(list); 1429 auto inquireFileUnit = [&]() -> bool { 1430 return exprPair.first && !exprPair.second; 1431 }; 1432 auto inquireFileName = [&]() -> bool { 1433 return exprPair.first && exprPair.second; 1434 }; 1435 1436 // Determine which BeginInquire call to make. 1437 if (inquireFileUnit()) { 1438 // File unit call. 1439 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireUnit)>(loc, builder); 1440 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1441 auto unit = converter.genExprValue(exprPair.first, loc); 1442 auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); 1443 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); 1444 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); 1445 llvm::SmallVector<mlir::Value, 4> beginArgs{un, file, line}; 1446 cookie = 1447 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1448 // Handle remaining arguments in specifier list. 1449 genConditionHandlerCall(converter, loc, cookie, *list, csi); 1450 } else if (inquireFileName()) { 1451 // Filename call. 1452 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireFile)>(loc, builder); 1453 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1454 auto file = converter.genExprValue(exprPair.first, loc); 1455 // Helper to query [BUFFER, LEN]. 1456 Fortran::lower::CharacterExprHelper helper(builder, loc); 1457 auto dataLen = helper.materializeCharacter(file); 1458 auto buff = 1459 builder.createConvert(loc, beginFuncTy.getInput(0), dataLen.first); 1460 auto len = 1461 builder.createConvert(loc, beginFuncTy.getInput(1), dataLen.second); 1462 auto kindInt = helper.getCharacterKind(file.getType()); 1463 mlir::Value kindValue = 1464 builder.createIntegerConstant(loc, beginFuncTy.getInput(2), kindInt); 1465 auto sourceFile = getDefaultFilename(builder, loc, beginFuncTy.getInput(3)); 1466 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(4)); 1467 llvm::SmallVector<mlir::Value, 5> beginArgs = { 1468 buff, len, kindValue, sourceFile, line, 1469 }; 1470 cookie = 1471 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1472 // Handle remaining arguments in specifier list. 1473 genConditionHandlerCall(converter, loc, cookie, *list, csi); 1474 } else { 1475 // Io length call. 1476 const auto *ioLength = 1477 std::get_if<Fortran::parser::InquireStmt::Iolength>(&stmt.u); 1478 assert(ioLength && "must have an io length"); 1479 beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireIoLength)>(loc, builder); 1480 mlir::FunctionType beginFuncTy = beginFunc.getType(); 1481 auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(0)); 1482 auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(1)); 1483 llvm::SmallVector<mlir::Value, 4> beginArgs{file, line}; 1484 cookie = 1485 builder.create<mlir::CallOp>(loc, beginFunc, beginArgs).getResult(0); 1486 // Handle remaining arguments in output list. 1487 genConditionHandlerCall( 1488 converter, loc, cookie, 1489 std::get<std::list<Fortran::parser::OutputItem>>(ioLength->t), csi); 1490 } 1491 // Generate end statement call. 1492 return genEndIO(converter, loc, cookie, csi); 1493 } 1494