1 //===-- IO.cpp -- IO statement lowering -----------------------------------===//
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
7 //===----------------------------------------------------------------------===//
9 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
11 //===----------------------------------------------------------------------===//
13 #include "flang/Lower/IO.h"
14 #include "flang/Common/uint128.h"
15 #include "flang/Evaluate/tools.h"
16 #include "flang/Lower/Allocatable.h"
17 #include "flang/Lower/Bridge.h"
18 #include "flang/Lower/CallInterface.h"
19 #include "flang/Lower/ConvertExpr.h"
20 #include "flang/Lower/ConvertVariable.h"
21 #include "flang/Lower/Mangler.h"
22 #include "flang/Lower/PFTBuilder.h"
23 #include "flang/Lower/Runtime.h"
24 #include "flang/Lower/StatementContext.h"
25 #include "flang/Lower/Support/Utils.h"
26 #include "flang/Lower/VectorSubscripts.h"
27 #include "flang/Optimizer/Builder/Character.h"
28 #include "flang/Optimizer/Builder/Complex.h"
29 #include "flang/Optimizer/Builder/FIRBuilder.h"
30 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
31 #include "flang/Optimizer/Builder/Runtime/Stop.h"
32 #include "flang/Optimizer/Builder/Todo.h"
33 #include "flang/Optimizer/Dialect/FIRDialect.h"
34 #include "flang/Optimizer/Dialect/Support/FIRContext.h"
35 #include "flang/Parser/parse-tree.h"
36 #include "flang/Runtime/io-api.h"
37 #include "flang/Semantics/runtime-type-info.h"
38 #include "flang/Semantics/tools.h"
39 #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
40 #include "llvm/Support/Debug.h"
43 #define DEBUG_TYPE "flang-lower-io"
45 // Define additional runtime type models specific to IO.
46 namespace fir::runtime
{
48 constexpr TypeBuilderFunc getModel
<Fortran::runtime::io::IoStatementState
*>() {
49 return getModel
<char *>();
52 constexpr TypeBuilderFunc getModel
<Fortran::runtime::io::Iostat
>() {
53 return [](mlir::MLIRContext
*context
) -> mlir::Type
{
54 return mlir::IntegerType::get(context
,
55 8 * sizeof(Fortran::runtime::io::Iostat
));
59 constexpr TypeBuilderFunc
60 getModel
<const Fortran::runtime::io::NamelistGroup
&>() {
61 return [](mlir::MLIRContext
*context
) -> mlir::Type
{
62 return fir::ReferenceType::get(mlir::TupleType::get(context
));
66 constexpr TypeBuilderFunc
67 getModel
<const Fortran::runtime::io::NonTbpDefinedIoTable
*>() {
68 return [](mlir::MLIRContext
*context
) -> mlir::Type
{
69 return fir::ReferenceType::get(mlir::TupleType::get(context
));
72 } // namespace fir::runtime
74 using namespace Fortran::runtime::io
;
76 #define mkIOKey(X) FirmkKey(IONAME(X))
78 namespace Fortran::lower
{
79 /// Static table of IO runtime calls
81 /// This logical map contains the name and type builder function for each IO
82 /// runtime function listed in the tuple. This table is fully constructed at
83 /// compile-time. Use the `mkIOKey` macro to access the table.
84 static constexpr std::tuple
<
85 mkIOKey(BeginBackspace
), mkIOKey(BeginClose
), mkIOKey(BeginEndfile
),
86 mkIOKey(BeginExternalFormattedInput
), mkIOKey(BeginExternalFormattedOutput
),
87 mkIOKey(BeginExternalListInput
), mkIOKey(BeginExternalListOutput
),
88 mkIOKey(BeginFlush
), mkIOKey(BeginInquireFile
),
89 mkIOKey(BeginInquireIoLength
), mkIOKey(BeginInquireUnit
),
90 mkIOKey(BeginInternalArrayFormattedInput
),
91 mkIOKey(BeginInternalArrayFormattedOutput
),
92 mkIOKey(BeginInternalArrayListInput
), mkIOKey(BeginInternalArrayListOutput
),
93 mkIOKey(BeginInternalFormattedInput
), mkIOKey(BeginInternalFormattedOutput
),
94 mkIOKey(BeginInternalListInput
), mkIOKey(BeginInternalListOutput
),
95 mkIOKey(BeginOpenNewUnit
), mkIOKey(BeginOpenUnit
), mkIOKey(BeginRewind
),
96 mkIOKey(BeginUnformattedInput
), mkIOKey(BeginUnformattedOutput
),
97 mkIOKey(BeginWait
), mkIOKey(BeginWaitAll
),
98 mkIOKey(CheckUnitNumberInRange64
), mkIOKey(CheckUnitNumberInRange128
),
99 mkIOKey(EnableHandlers
), mkIOKey(EndIoStatement
), mkIOKey(GetIoLength
),
100 mkIOKey(GetIoMsg
), mkIOKey(GetNewUnit
), mkIOKey(GetSize
),
101 mkIOKey(InputAscii
), mkIOKey(InputComplex32
), mkIOKey(InputComplex64
),
102 mkIOKey(InputDerivedType
), mkIOKey(InputDescriptor
), mkIOKey(InputInteger
),
103 mkIOKey(InputLogical
), mkIOKey(InputNamelist
), mkIOKey(InputReal32
),
104 mkIOKey(InputReal64
), mkIOKey(InquireCharacter
), mkIOKey(InquireInteger64
),
105 mkIOKey(InquireLogical
), mkIOKey(InquirePendingId
), mkIOKey(OutputAscii
),
106 mkIOKey(OutputComplex32
), mkIOKey(OutputComplex64
),
107 mkIOKey(OutputDerivedType
), mkIOKey(OutputDescriptor
),
108 mkIOKey(OutputInteger8
), mkIOKey(OutputInteger16
), mkIOKey(OutputInteger32
),
109 mkIOKey(OutputInteger64
), mkIOKey(OutputInteger128
), mkIOKey(OutputLogical
),
110 mkIOKey(OutputNamelist
), mkIOKey(OutputReal32
), mkIOKey(OutputReal64
),
111 mkIOKey(SetAccess
), mkIOKey(SetAction
), mkIOKey(SetAdvance
),
112 mkIOKey(SetAsynchronous
), mkIOKey(SetBlank
), mkIOKey(SetCarriagecontrol
),
113 mkIOKey(SetConvert
), mkIOKey(SetDecimal
), mkIOKey(SetDelim
),
114 mkIOKey(SetEncoding
), mkIOKey(SetFile
), mkIOKey(SetForm
), mkIOKey(SetPad
),
115 mkIOKey(SetPos
), mkIOKey(SetPosition
), mkIOKey(SetRec
), mkIOKey(SetRecl
),
116 mkIOKey(SetRound
), mkIOKey(SetSign
), mkIOKey(SetStatus
)>
118 } // namespace Fortran::lower
121 /// IO statements may require exceptional condition handling. A statement that
122 /// encounters an exceptional condition may branch to a label given on an ERR
123 /// (error), END (end-of-file), or EOR (end-of-record) specifier. An IOSTAT
124 /// specifier variable may be set to a value that indicates some condition,
125 /// and an IOMSG specifier variable may be set to a description of a condition.
126 struct ConditionSpecInfo
{
127 const Fortran::lower::SomeExpr
*ioStatExpr
{};
128 std::optional
<fir::ExtendedValue
> ioMsg
;
132 fir::IfOp bigUnitIfOp
;
134 /// Check for any condition specifier that applies to specifier processing.
135 bool hasErrorConditionSpec() const { return ioStatExpr
!= nullptr || hasErr
; }
137 /// Check for any condition specifier that applies to data transfer items
138 /// in a PRINT, READ, WRITE, or WAIT statement. (WAIT may be irrelevant.)
139 bool hasTransferConditionSpec() const {
140 return hasErrorConditionSpec() || hasEnd
|| hasEor
;
143 /// Check for any condition specifier, including IOMSG.
144 bool hasAnyConditionSpec() const {
145 return hasTransferConditionSpec() || ioMsg
;
150 template <typename D
>
151 static void genIoLoop(Fortran::lower::AbstractConverter
&converter
,
152 mlir::Value cookie
, const D
&ioImpliedDo
,
153 bool isFormatted
, bool checkResult
, mlir::Value
&ok
,
156 /// Helper function to retrieve the name of the IO function given the key `A`
157 template <typename A
>
158 static constexpr const char *getName() {
159 return std::get
<A
>(Fortran::lower::newIOTable
).name
;
162 /// Helper function to retrieve the type model signature builder of the IO
163 /// function as defined by the key `A`
164 template <typename A
>
165 static constexpr fir::runtime::FuncTypeBuilderFunc
getTypeModel() {
166 return std::get
<A
>(Fortran::lower::newIOTable
).getTypeModel();
169 inline int64_t getLength(mlir::Type argTy
) {
170 return argTy
.cast
<fir::SequenceType
>().getShape()[0];
173 /// Get (or generate) the MLIR FuncOp for a given IO runtime function.
174 template <typename E
>
175 static mlir::func::FuncOp
getIORuntimeFunc(mlir::Location loc
,
176 fir::FirOpBuilder
&builder
) {
177 llvm::StringRef name
= getName
<E
>();
178 mlir::func::FuncOp func
= builder
.getNamedFunction(name
);
181 auto funTy
= getTypeModel
<E
>()(builder
.getContext());
182 func
= builder
.createFunction(loc
, name
, funTy
);
183 func
->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(),
184 builder
.getUnitAttr());
185 func
->setAttr("fir.io", builder
.getUnitAttr());
189 /// Generate calls to end an IO statement. Return the IOSTAT value, if any.
190 /// It is the caller's responsibility to generate branches on that value.
191 static mlir::Value
genEndIO(Fortran::lower::AbstractConverter
&converter
,
192 mlir::Location loc
, mlir::Value cookie
,
193 ConditionSpecInfo
&csi
,
194 Fortran::lower::StatementContext
&stmtCtx
) {
195 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
197 mlir::func::FuncOp getIoMsg
=
198 getIORuntimeFunc
<mkIOKey(GetIoMsg
)>(loc
, builder
);
199 builder
.create
<fir::CallOp
>(
203 builder
.createConvert(loc
, getIoMsg
.getFunctionType().getInput(1),
204 fir::getBase(*csi
.ioMsg
)),
205 builder
.createConvert(loc
, getIoMsg
.getFunctionType().getInput(2),
206 fir::getLen(*csi
.ioMsg
))});
208 mlir::func::FuncOp endIoStatement
=
209 getIORuntimeFunc
<mkIOKey(EndIoStatement
)>(loc
, builder
);
210 auto call
= builder
.create
<fir::CallOp
>(loc
, endIoStatement
,
211 mlir::ValueRange
{cookie
});
212 mlir::Value iostat
= call
.getResult(0);
213 if (csi
.bigUnitIfOp
) {
214 stmtCtx
.finalizeAndPop();
215 builder
.create
<fir::ResultOp
>(loc
, iostat
);
216 builder
.setInsertionPointAfter(csi
.bigUnitIfOp
);
217 iostat
= csi
.bigUnitIfOp
.getResult(0);
219 if (csi
.ioStatExpr
) {
220 mlir::Value ioStatVar
=
221 fir::getBase(converter
.genExprAddr(loc
, csi
.ioStatExpr
, stmtCtx
));
222 mlir::Value ioStatResult
=
223 builder
.createConvert(loc
, converter
.genType(*csi
.ioStatExpr
), iostat
);
224 builder
.create
<fir::StoreOp
>(loc
, ioStatResult
, ioStatVar
);
226 return csi
.hasTransferConditionSpec() ? iostat
: mlir::Value
{};
229 /// Make the next call in the IO statement conditional on runtime result `ok`.
230 /// If a call returns `ok==false`, further suboperation calls for an IO
231 /// statement will be skipped. This may generate branch heavy, deeply nested
232 /// conditionals for IO statements with a large number of suboperations.
233 static void makeNextConditionalOn(fir::FirOpBuilder
&builder
,
234 mlir::Location loc
, bool checkResult
,
235 mlir::Value ok
, bool inLoop
= false) {
236 if (!checkResult
|| !ok
)
237 // Either no IO calls need to be checked, or this will be the first call.
240 // A previous IO call for a statement returned the bool `ok`. If this call
241 // is in a fir.iterate_while loop, the result must be propagated up to the
242 // loop scope as an extra ifOp result. (The propagation is done in genIoLoop.)
243 mlir::TypeRange resTy
;
245 resTy
= builder
.getI1Type();
246 auto ifOp
= builder
.create
<fir::IfOp
>(loc
, resTy
, ok
,
247 /*withElseRegion=*/inLoop
);
248 builder
.setInsertionPointToStart(&ifOp
.getThenRegion().front());
251 // Derived type symbols may each be mapped to up to 4 defined IO procedures.
252 using DefinedIoProcMap
= std::multimap
<const Fortran::semantics::Symbol
*,
253 Fortran::semantics::NonTbpDefinedIo
>;
255 /// Get the current scope's non-type-bound defined IO procedures.
256 static DefinedIoProcMap
257 getDefinedIoProcMap(Fortran::lower::AbstractConverter
&converter
) {
258 const Fortran::semantics::Scope
*scope
= &converter
.getCurrentScope();
259 for (; !scope
->IsGlobal(); scope
= &scope
->parent())
260 if (scope
->kind() == Fortran::semantics::Scope::Kind::MainProgram
||
261 scope
->kind() == Fortran::semantics::Scope::Kind::Subprogram
||
262 scope
->kind() == Fortran::semantics::Scope::Kind::BlockConstruct
)
264 return Fortran::semantics::CollectNonTbpDefinedIoGenericInterfaces(*scope
,
268 /// Check a set of defined IO procedures for any procedure pointer or dummy
270 static bool hasLocalDefinedIoProc(DefinedIoProcMap
&definedIoProcMap
) {
271 for (auto &iface
: definedIoProcMap
) {
272 const Fortran::semantics::Symbol
*procSym
= iface
.second
.subroutine
;
275 procSym
= &procSym
->GetUltimate();
276 if (Fortran::semantics::IsProcedurePointer(*procSym
) ||
277 Fortran::semantics::IsDummy(*procSym
))
283 /// Retrieve or generate a runtime description of the non-type-bound defined
284 /// IO procedures in the current scope. If any procedure is a dummy or a
285 /// procedure pointer, the result is local. Otherwise the result is static.
286 /// If there are no procedures, return a scope-independent default table with
287 /// an empty procedure list, but with the `ignoreNonTbpEntries` flag set. The
288 /// form of the description is defined in runtime header file non-tbp-dio.h.
290 getNonTbpDefinedIoTableAddr(Fortran::lower::AbstractConverter
&converter
,
291 DefinedIoProcMap
&definedIoProcMap
) {
292 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
293 mlir::MLIRContext
*context
= builder
.getContext();
294 mlir::Location loc
= converter
.getCurrentLocation();
295 mlir::Type refTy
= fir::ReferenceType::get(mlir::NoneType::get(context
));
296 std::string suffix
= ".nonTbpDefinedIoTable";
297 std::string tableMangleName
= definedIoProcMap
.empty()
299 : converter
.mangleName(suffix
);
300 if (auto table
= builder
.getNamedGlobal(tableMangleName
))
301 return builder
.createConvert(
303 builder
.create
<fir::AddrOfOp
>(loc
, table
.resultType(),
306 mlir::StringAttr linkOnce
= builder
.createLinkOnceLinkage();
307 mlir::Type idxTy
= builder
.getIndexType();
309 fir::runtime::getModel
<std::size_t>()(builder
.getContext());
310 mlir::Type intTy
= fir::runtime::getModel
<int>()(builder
.getContext());
311 mlir::Type boolTy
= fir::runtime::getModel
<bool>()(builder
.getContext());
312 mlir::Type listTy
= fir::SequenceType::get(
313 definedIoProcMap
.size(),
314 mlir::TupleType::get(context
, {refTy
, refTy
, intTy
, boolTy
}));
315 mlir::Type tableTy
= mlir::TupleType::get(
316 context
, {sizeTy
, fir::ReferenceType::get(listTy
), boolTy
});
318 // Define the list of NonTbpDefinedIo procedures.
320 !definedIoProcMap
.empty() && hasLocalDefinedIoProc(definedIoProcMap
);
321 mlir::Value listAddr
=
322 tableIsLocal
? builder
.create
<fir::AllocaOp
>(loc
, listTy
) : mlir::Value
{};
323 std::string listMangleName
= tableMangleName
+ ".list";
324 auto listFunc
= [&](fir::FirOpBuilder
&builder
) {
325 mlir::Value list
= builder
.create
<fir::UndefOp
>(loc
, listTy
);
326 mlir::IntegerAttr intAttr
[4];
327 for (int i
= 0; i
< 4; ++i
)
328 intAttr
[i
] = builder
.getIntegerAttr(idxTy
, i
);
329 llvm::SmallVector
<mlir::Attribute
, 2> idx
= {mlir::Attribute
{},
332 auto insert
= [&](mlir::Value val
) {
333 idx
[1] = intAttr
[n1
++];
334 list
= builder
.create
<fir::InsertValueOp
>(loc
, listTy
, list
, val
,
335 builder
.getArrayAttr(idx
));
337 for (auto &iface
: definedIoProcMap
) {
338 idx
[0] = builder
.getIntegerAttr(idxTy
, n0
++);
340 // derived type description [const typeInfo::DerivedType &derivedType]
341 const Fortran::semantics::Symbol
&dtSym
= iface
.first
->GetUltimate();
342 std::string dtName
= converter
.mangleName(dtSym
);
343 insert(builder
.createConvert(
345 builder
.create
<fir::AddrOfOp
>(
346 loc
, fir::ReferenceType::get(converter
.genType(dtSym
)),
347 builder
.getSymbolRefAttr(dtName
))));
348 // defined IO procedure [void (*subroutine)()], may be null
349 const Fortran::semantics::Symbol
*procSym
= iface
.second
.subroutine
;
351 procSym
= &procSym
->GetUltimate();
352 if (Fortran::semantics::IsProcedurePointer(*procSym
)) {
353 TODO(loc
, "defined IO procedure pointers");
354 } else if (Fortran::semantics::IsDummy(*procSym
)) {
355 Fortran::lower::StatementContext stmtCtx
;
356 insert(builder
.create
<fir::BoxAddrOp
>(
358 fir::getBase(converter
.genExprAddr(
360 Fortran::lower::SomeExpr
{
361 Fortran::evaluate::ProcedureDesignator
{*procSym
}},
364 mlir::func::FuncOp procDef
= Fortran::lower::getOrDeclareFunction(
365 Fortran::evaluate::ProcedureDesignator
{*procSym
}, converter
);
366 mlir::SymbolRefAttr nameAttr
=
367 builder
.getSymbolRefAttr(procDef
.getSymName());
368 insert(builder
.createConvert(
370 builder
.create
<fir::AddrOfOp
>(loc
, procDef
.getFunctionType(),
374 insert(builder
.createNullConstant(loc
, refTy
));
376 // defined IO variant, one of (read/write, formatted/unformatted)
377 // [common::DefinedIo definedIo]
378 insert(builder
.createIntegerConstant(
379 loc
, intTy
, static_cast<int>(iface
.second
.definedIo
)));
380 // polymorphic flag is set if first defined IO dummy arg is CLASS(T)
381 // [bool isDtvArgPolymorphic]
382 insert(builder
.createIntegerConstant(loc
, boolTy
,
383 iface
.second
.isDtvArgPolymorphic
));
386 builder
.create
<fir::StoreOp
>(loc
, list
, listAddr
);
388 builder
.create
<fir::HasValueOp
>(loc
, list
);
390 if (!definedIoProcMap
.empty()) {
394 builder
.createGlobalConstant(loc
, listTy
, listMangleName
, listFunc
,
398 // Define the NonTbpDefinedIoTable.
399 mlir::Value tableAddr
= tableIsLocal
400 ? builder
.create
<fir::AllocaOp
>(loc
, tableTy
)
402 auto tableFunc
= [&](fir::FirOpBuilder
&builder
) {
403 mlir::Value table
= builder
.create
<fir::UndefOp
>(loc
, tableTy
);
404 // list item count [std::size_t items]
405 table
= builder
.create
<fir::InsertValueOp
>(
407 builder
.createIntegerConstant(loc
, sizeTy
, definedIoProcMap
.size()),
408 builder
.getArrayAttr(builder
.getIntegerAttr(idxTy
, 0)));
409 // item list [const NonTbpDefinedIo *item]
410 if (definedIoProcMap
.empty())
411 listAddr
= builder
.createNullConstant(loc
, builder
.getRefType(listTy
));
412 else if (fir::GlobalOp list
= builder
.getNamedGlobal(listMangleName
))
413 listAddr
= builder
.create
<fir::AddrOfOp
>(loc
, list
.resultType(),
415 assert(listAddr
&& "missing namelist object list");
416 table
= builder
.create
<fir::InsertValueOp
>(
417 loc
, tableTy
, table
, listAddr
,
418 builder
.getArrayAttr(builder
.getIntegerAttr(idxTy
, 1)));
419 // [bool ignoreNonTbpEntries] conservatively set to true
420 table
= builder
.create
<fir::InsertValueOp
>(
421 loc
, tableTy
, table
, builder
.createIntegerConstant(loc
, boolTy
, true),
422 builder
.getArrayAttr(builder
.getIntegerAttr(idxTy
, 2)));
424 builder
.create
<fir::StoreOp
>(loc
, table
, tableAddr
);
426 builder
.create
<fir::HasValueOp
>(loc
, table
);
431 fir::GlobalOp table
= builder
.createGlobal(
432 loc
, tableTy
, tableMangleName
,
433 /*isConst=*/true, /*isTarget=*/false, tableFunc
, linkOnce
);
434 tableAddr
= builder
.create
<fir::AddrOfOp
>(
435 loc
, fir::ReferenceType::get(tableTy
), table
.getSymbol());
437 assert(tableAddr
&& "missing NonTbpDefinedIo table result");
438 return builder
.createConvert(loc
, refTy
, tableAddr
);
442 getNonTbpDefinedIoTableAddr(Fortran::lower::AbstractConverter
&converter
) {
443 DefinedIoProcMap definedIoProcMap
= getDefinedIoProcMap(converter
);
444 return getNonTbpDefinedIoTableAddr(converter
, definedIoProcMap
);
447 /// Retrieve or generate a runtime description of NAMELIST group \p symbol.
448 /// The form of the description is defined in runtime header file namelist.h.
449 /// Static descriptors are generated for global objects; local descriptors for
450 /// local objects. If all descriptors and defined IO procedures are static,
451 /// the NamelistGroup is static.
453 getNamelistGroup(Fortran::lower::AbstractConverter
&converter
,
454 const Fortran::semantics::Symbol
&symbol
,
455 Fortran::lower::StatementContext
&stmtCtx
) {
456 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
457 mlir::Location loc
= converter
.getCurrentLocation();
458 std::string groupMangleName
= converter
.mangleName(symbol
);
459 if (auto group
= builder
.getNamedGlobal(groupMangleName
))
460 return builder
.create
<fir::AddrOfOp
>(loc
, group
.resultType(),
463 const auto &details
=
464 symbol
.GetUltimate().get
<Fortran::semantics::NamelistDetails
>();
465 mlir::MLIRContext
*context
= builder
.getContext();
466 mlir::StringAttr linkOnce
= builder
.createLinkOnceLinkage();
467 mlir::Type idxTy
= builder
.getIndexType();
469 fir::runtime::getModel
<std::size_t>()(builder
.getContext());
470 mlir::Type charRefTy
= fir::ReferenceType::get(builder
.getIntegerType(8));
471 mlir::Type descRefTy
=
472 fir::ReferenceType::get(fir::BoxType::get(mlir::NoneType::get(context
)));
473 mlir::Type listTy
= fir::SequenceType::get(
474 details
.objects().size(),
475 mlir::TupleType::get(context
, {charRefTy
, descRefTy
}));
476 mlir::Type groupTy
= mlir::TupleType::get(
477 context
, {charRefTy
, sizeTy
, fir::ReferenceType::get(listTy
),
478 fir::ReferenceType::get(mlir::NoneType::get(context
))});
479 auto stringAddress
= [&](const Fortran::semantics::Symbol
&symbol
) {
480 return fir::factory::createStringLiteral(builder
, loc
,
481 symbol
.name().ToString() + '\0');
484 // Define variable names, and static descriptors for global variables.
485 DefinedIoProcMap definedIoProcMap
= getDefinedIoProcMap(converter
);
486 bool groupIsLocal
= hasLocalDefinedIoProc(definedIoProcMap
);
487 stringAddress(symbol
);
488 for (const Fortran::semantics::Symbol
&s
: details
.objects()) {
490 if (!Fortran::lower::symbolIsGlobal(s
)) {
494 // A global pointer or allocatable variable has a descriptor for typical
495 // accesses. Variables in multiple namelist groups may already have one.
496 // Create descriptors for other cases.
497 if (!IsAllocatableOrObjectPointer(&s
)) {
498 std::string mangleName
=
499 Fortran::lower::mangle::globalNamelistDescriptorName(s
);
500 if (builder
.getNamedGlobal(mangleName
))
502 const auto expr
= Fortran::evaluate::AsGenericExpr(s
);
504 fir::BoxType::get(fir::PointerType::get(converter
.genType(s
)));
505 auto descFunc
= [&](fir::FirOpBuilder
&b
) {
506 auto box
= Fortran::lower::genInitialDataTarget(
507 converter
, loc
, boxTy
, *expr
, /*couldBeInEquivalence=*/true);
508 b
.create
<fir::HasValueOp
>(loc
, box
);
510 builder
.createGlobalConstant(loc
, boxTy
, mangleName
, descFunc
, linkOnce
);
514 // Define the list of Items.
515 mlir::Value listAddr
=
516 groupIsLocal
? builder
.create
<fir::AllocaOp
>(loc
, listTy
) : mlir::Value
{};
517 std::string listMangleName
= groupMangleName
+ ".list";
518 auto listFunc
= [&](fir::FirOpBuilder
&builder
) {
519 mlir::Value list
= builder
.create
<fir::UndefOp
>(loc
, listTy
);
520 mlir::IntegerAttr zero
= builder
.getIntegerAttr(idxTy
, 0);
521 mlir::IntegerAttr one
= builder
.getIntegerAttr(idxTy
, 1);
522 llvm::SmallVector
<mlir::Attribute
, 2> idx
= {mlir::Attribute
{},
525 for (const Fortran::semantics::Symbol
&s
: details
.objects()) {
526 idx
[0] = builder
.getIntegerAttr(idxTy
, n
++);
528 mlir::Value nameAddr
=
529 builder
.createConvert(loc
, charRefTy
, fir::getBase(stringAddress(s
)));
530 list
= builder
.create
<fir::InsertValueOp
>(loc
, listTy
, list
, nameAddr
,
531 builder
.getArrayAttr(idx
));
533 mlir::Value descAddr
;
534 if (auto desc
= builder
.getNamedGlobal(
535 Fortran::lower::mangle::globalNamelistDescriptorName(s
))) {
536 descAddr
= builder
.create
<fir::AddrOfOp
>(loc
, desc
.resultType(),
538 } else if (Fortran::semantics::FindCommonBlockContaining(s
) &&
539 IsAllocatableOrPointer(s
)) {
540 mlir::Type symType
= converter
.genType(s
);
541 const Fortran::semantics::Symbol
*commonBlockSym
=
542 Fortran::semantics::FindCommonBlockContaining(s
);
543 std::string commonBlockName
= converter
.mangleName(*commonBlockSym
);
544 fir::GlobalOp commonGlobal
= builder
.getNamedGlobal(commonBlockName
);
545 mlir::Value commonBlockAddr
= builder
.create
<fir::AddrOfOp
>(
546 loc
, commonGlobal
.resultType(), commonGlobal
.getSymbol());
547 mlir::IntegerType i8Ty
= builder
.getIntegerType(8);
548 mlir::Type i8Ptr
= builder
.getRefType(i8Ty
);
549 mlir::Type seqTy
= builder
.getRefType(builder
.getVarLenSeqTy(i8Ty
));
550 mlir::Value base
= builder
.createConvert(loc
, seqTy
, commonBlockAddr
);
551 std::size_t byteOffset
= s
.GetUltimate().offset();
552 mlir::Value offs
= builder
.createIntegerConstant(
553 loc
, builder
.getIndexType(), byteOffset
);
554 mlir::Value varAddr
= builder
.create
<fir::CoordinateOp
>(
555 loc
, i8Ptr
, base
, mlir::ValueRange
{offs
});
557 builder
.createConvert(loc
, builder
.getRefType(symType
), varAddr
);
559 const auto expr
= Fortran::evaluate::AsGenericExpr(s
);
560 fir::ExtendedValue exv
= converter
.genExprAddr(*expr
, stmtCtx
);
561 mlir::Type type
= fir::getBase(exv
).getType();
562 if (mlir::Type baseTy
= fir::dyn_cast_ptrOrBoxEleTy(type
))
564 fir::BoxType boxType
= fir::BoxType::get(fir::PointerType::get(type
));
565 descAddr
= builder
.createTemporary(loc
, boxType
);
566 fir::MutableBoxValue box
= fir::MutableBoxValue(descAddr
, {}, {});
567 fir::factory::associateMutableBox(builder
, loc
, box
, exv
,
568 /*lbounds=*/std::nullopt
);
570 descAddr
= builder
.createConvert(loc
, descRefTy
, descAddr
);
571 list
= builder
.create
<fir::InsertValueOp
>(loc
, listTy
, list
, descAddr
,
572 builder
.getArrayAttr(idx
));
575 builder
.create
<fir::StoreOp
>(loc
, list
, listAddr
);
577 builder
.create
<fir::HasValueOp
>(loc
, list
);
582 builder
.createGlobalConstant(loc
, listTy
, listMangleName
, listFunc
,
586 mlir::Value groupAddr
= groupIsLocal
587 ? builder
.create
<fir::AllocaOp
>(loc
, groupTy
)
589 auto groupFunc
= [&](fir::FirOpBuilder
&builder
) {
590 mlir::Value group
= builder
.create
<fir::UndefOp
>(loc
, groupTy
);
591 // group name [const char *groupName]
592 group
= builder
.create
<fir::InsertValueOp
>(
594 builder
.createConvert(loc
, charRefTy
,
595 fir::getBase(stringAddress(symbol
))),
596 builder
.getArrayAttr(builder
.getIntegerAttr(idxTy
, 0)));
597 // list item count [std::size_t items]
598 group
= builder
.create
<fir::InsertValueOp
>(
600 builder
.createIntegerConstant(loc
, sizeTy
, details
.objects().size()),
601 builder
.getArrayAttr(builder
.getIntegerAttr(idxTy
, 1)));
602 // item list [const Item *item]
603 if (fir::GlobalOp list
= builder
.getNamedGlobal(listMangleName
))
604 listAddr
= builder
.create
<fir::AddrOfOp
>(loc
, list
.resultType(),
606 assert(listAddr
&& "missing namelist object list");
607 group
= builder
.create
<fir::InsertValueOp
>(
608 loc
, groupTy
, group
, listAddr
,
609 builder
.getArrayAttr(builder
.getIntegerAttr(idxTy
, 2)));
610 // non-type-bound defined IO procedures
611 // [const NonTbpDefinedIoTable *nonTbpDefinedIo]
612 group
= builder
.create
<fir::InsertValueOp
>(
614 getNonTbpDefinedIoTableAddr(converter
, definedIoProcMap
),
615 builder
.getArrayAttr(builder
.getIntegerAttr(idxTy
, 3)));
617 builder
.create
<fir::StoreOp
>(loc
, group
, groupAddr
);
619 builder
.create
<fir::HasValueOp
>(loc
, group
);
624 fir::GlobalOp group
= builder
.createGlobal(
625 loc
, groupTy
, groupMangleName
,
626 /*isConst=*/true, /*isTarget=*/false, groupFunc
, linkOnce
);
627 groupAddr
= builder
.create
<fir::AddrOfOp
>(loc
, group
.resultType(),
630 assert(groupAddr
&& "missing namelist group result");
634 /// Generate a namelist IO call.
635 static void genNamelistIO(Fortran::lower::AbstractConverter
&converter
,
636 mlir::Value cookie
, mlir::func::FuncOp funcOp
,
637 Fortran::semantics::Symbol
&symbol
, bool checkResult
,
639 Fortran::lower::StatementContext
&stmtCtx
) {
640 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
641 mlir::Location loc
= converter
.getCurrentLocation();
642 makeNextConditionalOn(builder
, loc
, checkResult
, ok
);
643 mlir::Type argType
= funcOp
.getFunctionType().getInput(1);
644 mlir::Value groupAddr
=
645 getNamelistGroup(converter
, symbol
.GetUltimate(), stmtCtx
);
646 groupAddr
= builder
.createConvert(loc
, argType
, groupAddr
);
647 llvm::SmallVector
<mlir::Value
> args
= {cookie
, groupAddr
};
648 ok
= builder
.create
<fir::CallOp
>(loc
, funcOp
, args
).getResult(0);
651 /// Get the output function to call for a value of the given type.
652 static mlir::func::FuncOp
getOutputFunc(mlir::Location loc
,
653 fir::FirOpBuilder
&builder
,
654 mlir::Type type
, bool isFormatted
) {
655 if (fir::unwrapPassByRefType(type
).isa
<fir::RecordType
>())
656 return getIORuntimeFunc
<mkIOKey(OutputDerivedType
)>(loc
, builder
);
658 return getIORuntimeFunc
<mkIOKey(OutputDescriptor
)>(loc
, builder
);
659 if (auto ty
= type
.dyn_cast
<mlir::IntegerType
>()) {
660 switch (ty
.getWidth()) {
662 return getIORuntimeFunc
<mkIOKey(OutputLogical
)>(loc
, builder
);
664 return getIORuntimeFunc
<mkIOKey(OutputInteger8
)>(loc
, builder
);
666 return getIORuntimeFunc
<mkIOKey(OutputInteger16
)>(loc
, builder
);
668 return getIORuntimeFunc
<mkIOKey(OutputInteger32
)>(loc
, builder
);
670 return getIORuntimeFunc
<mkIOKey(OutputInteger64
)>(loc
, builder
);
672 return getIORuntimeFunc
<mkIOKey(OutputInteger128
)>(loc
, builder
);
674 llvm_unreachable("unknown OutputInteger kind");
676 if (auto ty
= type
.dyn_cast
<mlir::FloatType
>()) {
677 if (auto width
= ty
.getWidth(); width
== 32)
678 return getIORuntimeFunc
<mkIOKey(OutputReal32
)>(loc
, builder
);
679 else if (width
== 64)
680 return getIORuntimeFunc
<mkIOKey(OutputReal64
)>(loc
, builder
);
682 auto kindMap
= fir::getKindMapping(builder
.getModule());
683 if (auto ty
= type
.dyn_cast
<fir::ComplexType
>()) {
684 // COMPLEX(KIND=k) corresponds to a pair of REAL(KIND=k).
685 auto width
= kindMap
.getRealBitsize(ty
.getFKind());
687 return getIORuntimeFunc
<mkIOKey(OutputComplex32
)>(loc
, builder
);
688 else if (width
== 64)
689 return getIORuntimeFunc
<mkIOKey(OutputComplex64
)>(loc
, builder
);
691 if (type
.isa
<fir::LogicalType
>())
692 return getIORuntimeFunc
<mkIOKey(OutputLogical
)>(loc
, builder
);
693 if (fir::factory::CharacterExprHelper::isCharacterScalar(type
)) {
694 // TODO: What would it mean if the default CHARACTER KIND is set to a wide
695 // character encoding scheme? How do we handle UTF-8? Is it a distinct KIND
696 // value? For now, assume that if the default CHARACTER KIND is 8 bit,
697 // then it is an ASCII string and UTF-8 is unsupported.
698 auto asciiKind
= kindMap
.defaultCharacterKind();
699 if (kindMap
.getCharacterBitsize(asciiKind
) == 8 &&
700 fir::factory::CharacterExprHelper::getCharacterKind(type
) == asciiKind
)
701 return getIORuntimeFunc
<mkIOKey(OutputAscii
)>(loc
, builder
);
703 return getIORuntimeFunc
<mkIOKey(OutputDescriptor
)>(loc
, builder
);
706 /// Generate a sequence of output data transfer calls.
707 static void genOutputItemList(
708 Fortran::lower::AbstractConverter
&converter
, mlir::Value cookie
,
709 const std::list
<Fortran::parser::OutputItem
> &items
, bool isFormatted
,
710 bool checkResult
, mlir::Value
&ok
, bool inLoop
) {
711 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
712 for (const Fortran::parser::OutputItem
&item
: items
) {
713 if (const auto &impliedDo
= std::get_if
<1>(&item
.u
)) {
714 genIoLoop(converter
, cookie
, impliedDo
->value(), isFormatted
, checkResult
,
718 auto &pExpr
= std::get
<Fortran::parser::Expr
>(item
.u
);
719 mlir::Location loc
= converter
.genLocation(pExpr
.source
);
720 makeNextConditionalOn(builder
, loc
, checkResult
, ok
, inLoop
);
721 Fortran::lower::StatementContext stmtCtx
;
723 const auto *expr
= Fortran::semantics::GetExpr(pExpr
);
725 fir::emitFatalError(loc
, "internal error: could not get evaluate::Expr");
726 mlir::Type itemTy
= converter
.genType(*expr
);
727 mlir::func::FuncOp outputFunc
=
728 getOutputFunc(loc
, builder
, itemTy
, isFormatted
);
729 mlir::Type argType
= outputFunc
.getFunctionType().getInput(1);
730 assert((isFormatted
|| argType
.isa
<fir::BoxType
>()) &&
731 "expect descriptor for unformatted IO runtime");
732 llvm::SmallVector
<mlir::Value
> outputFuncArgs
= {cookie
};
733 fir::factory::CharacterExprHelper helper
{builder
, loc
};
734 if (argType
.isa
<fir::BoxType
>()) {
735 mlir::Value box
= fir::getBase(converter
.genExprBox(loc
, *expr
, stmtCtx
));
736 outputFuncArgs
.push_back(builder
.createConvert(loc
, argType
, box
));
737 if (fir::unwrapPassByRefType(itemTy
).isa
<fir::RecordType
>())
738 outputFuncArgs
.push_back(getNonTbpDefinedIoTableAddr(converter
));
739 } else if (helper
.isCharacterScalar(itemTy
)) {
740 fir::ExtendedValue exv
= converter
.genExprAddr(loc
, expr
, stmtCtx
);
741 // scalar allocatable/pointer may also get here, not clear if
742 // genExprAddr will lower them as CharBoxValue or BoxValue.
743 if (!exv
.getCharBox())
744 llvm::report_fatal_error(
745 "internal error: scalar character not in CharBox");
746 outputFuncArgs
.push_back(builder
.createConvert(
747 loc
, outputFunc
.getFunctionType().getInput(1), fir::getBase(exv
)));
748 outputFuncArgs
.push_back(builder
.createConvert(
749 loc
, outputFunc
.getFunctionType().getInput(2), fir::getLen(exv
)));
751 fir::ExtendedValue itemBox
= converter
.genExprValue(loc
, expr
, stmtCtx
);
752 mlir::Value itemValue
= fir::getBase(itemBox
);
753 if (fir::isa_complex(itemTy
)) {
755 fir::factory::Complex
{builder
, loc
}.extractParts(itemValue
);
756 outputFuncArgs
.push_back(parts
.first
);
757 outputFuncArgs
.push_back(parts
.second
);
759 itemValue
= builder
.createConvert(loc
, argType
, itemValue
);
760 outputFuncArgs
.push_back(itemValue
);
763 ok
= builder
.create
<fir::CallOp
>(loc
, outputFunc
, outputFuncArgs
)
768 /// Get the input function to call for a value of the given type.
769 static mlir::func::FuncOp
getInputFunc(mlir::Location loc
,
770 fir::FirOpBuilder
&builder
,
771 mlir::Type type
, bool isFormatted
) {
772 if (fir::unwrapPassByRefType(type
).isa
<fir::RecordType
>())
773 return getIORuntimeFunc
<mkIOKey(InputDerivedType
)>(loc
, builder
);
775 return getIORuntimeFunc
<mkIOKey(InputDescriptor
)>(loc
, builder
);
776 if (auto ty
= type
.dyn_cast
<mlir::IntegerType
>())
777 return ty
.getWidth() == 1
778 ? getIORuntimeFunc
<mkIOKey(InputLogical
)>(loc
, builder
)
779 : getIORuntimeFunc
<mkIOKey(InputInteger
)>(loc
, builder
);
780 if (auto ty
= type
.dyn_cast
<mlir::FloatType
>()) {
781 if (auto width
= ty
.getWidth(); width
== 32)
782 return getIORuntimeFunc
<mkIOKey(InputReal32
)>(loc
, builder
);
783 else if (width
== 64)
784 return getIORuntimeFunc
<mkIOKey(InputReal64
)>(loc
, builder
);
786 auto kindMap
= fir::getKindMapping(builder
.getModule());
787 if (auto ty
= type
.dyn_cast
<fir::ComplexType
>()) {
788 auto width
= kindMap
.getRealBitsize(ty
.getFKind());
790 return getIORuntimeFunc
<mkIOKey(InputComplex32
)>(loc
, builder
);
791 else if (width
== 64)
792 return getIORuntimeFunc
<mkIOKey(InputComplex64
)>(loc
, builder
);
794 if (type
.isa
<fir::LogicalType
>())
795 return getIORuntimeFunc
<mkIOKey(InputLogical
)>(loc
, builder
);
796 if (fir::factory::CharacterExprHelper::isCharacterScalar(type
)) {
797 auto asciiKind
= kindMap
.defaultCharacterKind();
798 if (kindMap
.getCharacterBitsize(asciiKind
) == 8 &&
799 fir::factory::CharacterExprHelper::getCharacterKind(type
) == asciiKind
)
800 return getIORuntimeFunc
<mkIOKey(InputAscii
)>(loc
, builder
);
802 return getIORuntimeFunc
<mkIOKey(InputDescriptor
)>(loc
, builder
);
805 /// Interpret the lowest byte of a LOGICAL and store that value into the full
806 /// storage of the LOGICAL. The load, convert, and store effectively (sign or
807 /// zero) extends the lowest byte into the full LOGICAL value storage, as the
808 /// runtime is unaware of the LOGICAL value's actual bit width (it was passed
809 /// as a `bool&` to the runtime in order to be set).
810 static void boolRefToLogical(mlir::Location loc
, fir::FirOpBuilder
&builder
,
812 auto boolType
= builder
.getRefType(builder
.getI1Type());
813 auto boolAddr
= builder
.createConvert(loc
, boolType
, addr
);
814 auto boolValue
= builder
.create
<fir::LoadOp
>(loc
, boolAddr
);
815 auto logicalType
= fir::unwrapPassByRefType(addr
.getType());
816 // The convert avoid making any assumptions about how LOGICALs are actually
817 // represented (it might end-up being either a signed or zero extension).
818 auto logicalValue
= builder
.createConvert(loc
, logicalType
, boolValue
);
819 builder
.create
<fir::StoreOp
>(loc
, logicalValue
, addr
);
823 createIoRuntimeCallForItem(Fortran::lower::AbstractConverter
&converter
,
824 mlir::Location loc
, mlir::func::FuncOp inputFunc
,
825 mlir::Value cookie
, const fir::ExtendedValue
&item
) {
826 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
827 mlir::Type argType
= inputFunc
.getFunctionType().getInput(1);
828 llvm::SmallVector
<mlir::Value
> inputFuncArgs
= {cookie
};
829 if (argType
.isa
<fir::BaseBoxType
>()) {
830 mlir::Value box
= fir::getBase(item
);
831 auto boxTy
= box
.getType().dyn_cast
<fir::BaseBoxType
>();
832 assert(boxTy
&& "must be previously emboxed");
833 inputFuncArgs
.push_back(builder
.createConvert(loc
, argType
, box
));
834 if (fir::unwrapPassByRefType(boxTy
).isa
<fir::RecordType
>())
835 inputFuncArgs
.push_back(getNonTbpDefinedIoTableAddr(converter
));
837 mlir::Value itemAddr
= fir::getBase(item
);
838 mlir::Type itemTy
= fir::unwrapPassByRefType(itemAddr
.getType());
839 inputFuncArgs
.push_back(builder
.createConvert(loc
, argType
, itemAddr
));
840 fir::factory::CharacterExprHelper charHelper
{builder
, loc
};
841 if (charHelper
.isCharacterScalar(itemTy
)) {
842 mlir::Value len
= fir::getLen(item
);
843 inputFuncArgs
.push_back(builder
.createConvert(
844 loc
, inputFunc
.getFunctionType().getInput(2), len
));
845 } else if (itemTy
.isa
<mlir::IntegerType
>()) {
846 inputFuncArgs
.push_back(builder
.create
<mlir::arith::ConstantOp
>(
847 loc
, builder
.getI32IntegerAttr(
848 itemTy
.cast
<mlir::IntegerType
>().getWidth() / 8)));
851 auto call
= builder
.create
<fir::CallOp
>(loc
, inputFunc
, inputFuncArgs
);
852 auto itemAddr
= fir::getBase(item
);
853 auto itemTy
= fir::unwrapRefType(itemAddr
.getType());
854 if (itemTy
.isa
<fir::LogicalType
>())
855 boolRefToLogical(loc
, builder
, itemAddr
);
856 return call
.getResult(0);
859 /// Generate a sequence of input data transfer calls.
860 static void genInputItemList(Fortran::lower::AbstractConverter
&converter
,
862 const std::list
<Fortran::parser::InputItem
> &items
,
863 bool isFormatted
, bool checkResult
,
864 mlir::Value
&ok
, bool inLoop
) {
865 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
866 for (const Fortran::parser::InputItem
&item
: items
) {
867 if (const auto &impliedDo
= std::get_if
<1>(&item
.u
)) {
868 genIoLoop(converter
, cookie
, impliedDo
->value(), isFormatted
, checkResult
,
872 auto &pVar
= std::get
<Fortran::parser::Variable
>(item
.u
);
873 mlir::Location loc
= converter
.genLocation(pVar
.GetSource());
874 makeNextConditionalOn(builder
, loc
, checkResult
, ok
, inLoop
);
875 Fortran::lower::StatementContext stmtCtx
;
876 const auto *expr
= Fortran::semantics::GetExpr(pVar
);
878 fir::emitFatalError(loc
, "internal error: could not get evaluate::Expr");
879 if (Fortran::evaluate::HasVectorSubscript(*expr
)) {
880 auto vectorSubscriptBox
=
881 Fortran::lower::genVectorSubscriptBox(loc
, converter
, stmtCtx
, *expr
);
882 mlir::func::FuncOp inputFunc
= getInputFunc(
883 loc
, builder
, vectorSubscriptBox
.getElementType(), isFormatted
);
885 inputFunc
.getFunctionType().getInput(1).isa
<fir::BoxType
>();
887 auto elementalGenerator
= [&](const fir::ExtendedValue
&element
) {
888 createIoRuntimeCallForItem(converter
, loc
, inputFunc
, cookie
,
889 mustBox
? builder
.createBox(loc
, element
)
892 vectorSubscriptBox
.loopOverElements(builder
, loc
, elementalGenerator
);
894 auto elementalGenerator
=
895 [&](const fir::ExtendedValue
&element
) -> mlir::Value
{
896 return createIoRuntimeCallForItem(
897 converter
, loc
, inputFunc
, cookie
,
898 mustBox
? builder
.createBox(loc
, element
) : element
);
901 ok
= builder
.createBool(loc
, true);
902 ok
= vectorSubscriptBox
.loopOverElementsWhile(builder
, loc
,
903 elementalGenerator
, ok
);
907 mlir::Type itemTy
= converter
.genType(*expr
);
908 mlir::func::FuncOp inputFunc
=
909 getInputFunc(loc
, builder
, itemTy
, isFormatted
);
910 auto itemExv
= inputFunc
.getFunctionType().getInput(1).isa
<fir::BoxType
>()
911 ? converter
.genExprBox(loc
, *expr
, stmtCtx
)
912 : converter
.genExprAddr(loc
, expr
, stmtCtx
);
913 ok
= createIoRuntimeCallForItem(converter
, loc
, inputFunc
, cookie
, itemExv
);
917 /// Generate an io-implied-do loop.
918 template <typename D
>
919 static void genIoLoop(Fortran::lower::AbstractConverter
&converter
,
920 mlir::Value cookie
, const D
&ioImpliedDo
,
921 bool isFormatted
, bool checkResult
, mlir::Value
&ok
,
923 Fortran::lower::StatementContext stmtCtx
;
924 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
925 mlir::Location loc
= converter
.getCurrentLocation();
926 makeNextConditionalOn(builder
, loc
, checkResult
, ok
, inLoop
);
927 const auto &itemList
= std::get
<0>(ioImpliedDo
.t
);
928 const auto &control
= std::get
<1>(ioImpliedDo
.t
);
929 const auto &loopSym
= *control
.name
.thing
.thing
.symbol
;
930 mlir::Value loopVar
= fir::getBase(converter
.genExprAddr(
931 Fortran::evaluate::AsGenericExpr(loopSym
).value(), stmtCtx
));
932 auto genControlValue
= [&](const Fortran::parser::ScalarIntExpr
&expr
) {
933 mlir::Value v
= fir::getBase(
934 converter
.genExprValue(*Fortran::semantics::GetExpr(expr
), stmtCtx
));
935 return builder
.createConvert(loc
, builder
.getIndexType(), v
);
937 mlir::Value lowerValue
= genControlValue(control
.lower
);
938 mlir::Value upperValue
= genControlValue(control
.upper
);
939 mlir::Value stepValue
=
940 control
.step
.has_value()
941 ? genControlValue(*control
.step
)
942 : builder
.create
<mlir::arith::ConstantIndexOp
>(loc
, 1);
943 auto genItemList
= [&](const D
&ioImpliedDo
) {
944 if constexpr (std::is_same_v
<D
, Fortran::parser::InputImpliedDo
>)
945 genInputItemList(converter
, cookie
, itemList
, isFormatted
, checkResult
,
946 ok
, /*inLoop=*/true);
948 genOutputItemList(converter
, cookie
, itemList
, isFormatted
, checkResult
,
949 ok
, /*inLoop=*/true);
952 // No IO call result checks - the loop is a fir.do_loop op.
953 auto doLoopOp
= builder
.create
<fir::DoLoopOp
>(
954 loc
, lowerValue
, upperValue
, stepValue
, /*unordered=*/false,
955 /*finalCountValue=*/true);
956 builder
.setInsertionPointToStart(doLoopOp
.getBody());
957 mlir::Value lcv
= builder
.createConvert(
958 loc
, fir::unwrapRefType(loopVar
.getType()), doLoopOp
.getInductionVar());
959 builder
.create
<fir::StoreOp
>(loc
, lcv
, loopVar
);
960 genItemList(ioImpliedDo
);
961 builder
.setInsertionPointToEnd(doLoopOp
.getBody());
962 mlir::Value result
= builder
.create
<mlir::arith::AddIOp
>(
963 loc
, doLoopOp
.getInductionVar(), doLoopOp
.getStep());
964 builder
.create
<fir::ResultOp
>(loc
, result
);
965 builder
.setInsertionPointAfter(doLoopOp
);
966 // The loop control variable may be used after the loop.
967 lcv
= builder
.createConvert(loc
, fir::unwrapRefType(loopVar
.getType()),
968 doLoopOp
.getResult(0));
969 builder
.create
<fir::StoreOp
>(loc
, lcv
, loopVar
);
972 // Check IO call results - the loop is a fir.iterate_while op.
974 ok
= builder
.createBool(loc
, true);
975 auto iterWhileOp
= builder
.create
<fir::IterWhileOp
>(
976 loc
, lowerValue
, upperValue
, stepValue
, ok
, /*finalCountValue*/ true);
977 builder
.setInsertionPointToStart(iterWhileOp
.getBody());
979 builder
.createConvert(loc
, fir::unwrapRefType(loopVar
.getType()),
980 iterWhileOp
.getInductionVar());
981 builder
.create
<fir::StoreOp
>(loc
, lcv
, loopVar
);
982 ok
= iterWhileOp
.getIterateVar();
983 mlir::Value falseValue
=
984 builder
.createIntegerConstant(loc
, builder
.getI1Type(), 0);
985 genItemList(ioImpliedDo
);
986 // Unwind nested IO call scopes, filling in true and false ResultOp's.
987 for (mlir::Operation
*op
= builder
.getBlock()->getParentOp();
988 mlir::isa
<fir::IfOp
>(op
); op
= op
->getBlock()->getParentOp()) {
989 auto ifOp
= mlir::dyn_cast
<fir::IfOp
>(op
);
990 mlir::Operation
*lastOp
= &ifOp
.getThenRegion().front().back();
991 builder
.setInsertionPointAfter(lastOp
);
992 // The primary ifOp result is the result of an IO call or loop.
993 if (mlir::isa
<fir::CallOp
, fir::IfOp
>(*lastOp
))
994 builder
.create
<fir::ResultOp
>(loc
, lastOp
->getResult(0));
996 builder
.create
<fir::ResultOp
>(loc
, ok
); // loop result
997 // The else branch propagates an early exit false result.
998 builder
.setInsertionPointToStart(&ifOp
.getElseRegion().front());
999 builder
.create
<fir::ResultOp
>(loc
, falseValue
);
1001 builder
.setInsertionPointToEnd(iterWhileOp
.getBody());
1002 mlir::OpResult iterateResult
= builder
.getBlock()->back().getResult(0);
1003 mlir::Value inductionResult0
= iterWhileOp
.getInductionVar();
1004 auto inductionResult1
= builder
.create
<mlir::arith::AddIOp
>(
1005 loc
, inductionResult0
, iterWhileOp
.getStep());
1006 auto inductionResult
= builder
.create
<mlir::arith::SelectOp
>(
1007 loc
, iterateResult
, inductionResult1
, inductionResult0
);
1008 llvm::SmallVector
<mlir::Value
> results
= {inductionResult
, iterateResult
};
1009 builder
.create
<fir::ResultOp
>(loc
, results
);
1010 ok
= iterWhileOp
.getResult(1);
1011 builder
.setInsertionPointAfter(iterWhileOp
);
1012 // The loop control variable may be used after the loop.
1013 lcv
= builder
.createConvert(loc
, fir::unwrapRefType(loopVar
.getType()),
1014 iterWhileOp
.getResult(0));
1015 builder
.create
<fir::StoreOp
>(loc
, lcv
, loopVar
);
1018 //===----------------------------------------------------------------------===//
1019 // Default argument generation.
1020 //===----------------------------------------------------------------------===//
1022 static mlir::Value
locToFilename(Fortran::lower::AbstractConverter
&converter
,
1023 mlir::Location loc
, mlir::Type toType
) {
1024 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1025 return builder
.createConvert(loc
, toType
,
1026 fir::factory::locationToFilename(builder
, loc
));
1029 static mlir::Value
locToLineNo(Fortran::lower::AbstractConverter
&converter
,
1030 mlir::Location loc
, mlir::Type toType
) {
1031 return fir::factory::locationToLineNo(converter
.getFirOpBuilder(), loc
,
1035 static mlir::Value
getDefaultScratch(fir::FirOpBuilder
&builder
,
1036 mlir::Location loc
, mlir::Type toType
) {
1037 mlir::Value null
= builder
.create
<mlir::arith::ConstantOp
>(
1038 loc
, builder
.getI64IntegerAttr(0));
1039 return builder
.createConvert(loc
, toType
, null
);
1042 static mlir::Value
getDefaultScratchLen(fir::FirOpBuilder
&builder
,
1043 mlir::Location loc
, mlir::Type toType
) {
1044 return builder
.create
<mlir::arith::ConstantOp
>(
1045 loc
, builder
.getIntegerAttr(toType
, 0));
1048 /// Generate a reference to a buffer and the length of buffer given
1049 /// a character expression. An array expression will be cast to scalar
1050 /// character as long as they are contiguous.
1051 static std::tuple
<mlir::Value
, mlir::Value
>
1052 genBuffer(Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1053 const Fortran::lower::SomeExpr
&expr
, mlir::Type strTy
,
1054 mlir::Type lenTy
, Fortran::lower::StatementContext
&stmtCtx
) {
1055 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1056 fir::ExtendedValue exprAddr
= converter
.genExprAddr(expr
, stmtCtx
);
1057 fir::factory::CharacterExprHelper
helper(builder
, loc
);
1058 using ValuePair
= std::pair
<mlir::Value
, mlir::Value
>;
1059 auto [buff
, len
] = exprAddr
.match(
1060 [&](const fir::CharBoxValue
&x
) -> ValuePair
{
1061 return {x
.getBuffer(), x
.getLen()};
1063 [&](const fir::CharArrayBoxValue
&x
) -> ValuePair
{
1064 fir::CharBoxValue scalar
= helper
.toScalarCharacter(x
);
1065 return {scalar
.getBuffer(), scalar
.getLen()};
1067 [&](const fir::BoxValue
&) -> ValuePair
{
1068 // May need to copy before after IO to handle contiguous
1069 // aspect. Not sure descriptor can get here though.
1070 TODO(loc
, "character descriptor to contiguous buffer");
1072 [&](const auto &) -> ValuePair
{
1073 llvm::report_fatal_error(
1074 "internal error: IO buffer is not a character");
1076 buff
= builder
.createConvert(loc
, strTy
, buff
);
1077 len
= builder
.createConvert(loc
, lenTy
, len
);
1081 /// Lower a string literal. Many arguments to the runtime are conveyed as
1082 /// Fortran CHARACTER literals.
1083 template <typename A
>
1084 static std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
>
1085 lowerStringLit(Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1086 Fortran::lower::StatementContext
&stmtCtx
, const A
&syntax
,
1087 mlir::Type strTy
, mlir::Type lenTy
, mlir::Type ty2
= {}) {
1088 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1089 auto *expr
= Fortran::semantics::GetExpr(syntax
);
1091 fir::emitFatalError(loc
, "internal error: null semantic expr in IO");
1092 auto [buff
, len
] = genBuffer(converter
, loc
, *expr
, strTy
, lenTy
, stmtCtx
);
1095 auto kindVal
= expr
->GetType().value().kind();
1096 kind
= builder
.create
<mlir::arith::ConstantOp
>(
1097 loc
, builder
.getIntegerAttr(ty2
, kindVal
));
1099 return {buff
, len
, kind
};
1102 /// Pass the body of the FORMAT statement in as if it were a CHARACTER literal
1103 /// constant. NB: This is the prescribed manner in which the front-end passes
1104 /// this information to lowering.
1105 static std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
>
1106 lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter
&converter
,
1107 mlir::Location loc
, llvm::StringRef text
,
1108 mlir::Type strTy
, mlir::Type lenTy
) {
1109 text
= text
.drop_front(text
.find('('));
1110 text
= text
.take_front(text
.rfind(')') + 1);
1111 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1112 mlir::Value addrGlobalStringLit
=
1113 fir::getBase(fir::factory::createStringLiteral(builder
, loc
, text
));
1114 mlir::Value buff
= builder
.createConvert(loc
, strTy
, addrGlobalStringLit
);
1115 mlir::Value len
= builder
.createIntegerConstant(loc
, lenTy
, text
.size());
1116 return {buff
, len
, mlir::Value
{}};
1119 //===----------------------------------------------------------------------===//
1120 // Handle IO statement specifiers.
1121 // These are threaded together for a single statement via the passed cookie.
1122 //===----------------------------------------------------------------------===//
1124 /// Generic to build an integral argument to the runtime.
1125 template <typename A
, typename B
>
1126 mlir::Value
genIntIOOption(Fortran::lower::AbstractConverter
&converter
,
1127 mlir::Location loc
, mlir::Value cookie
,
1129 Fortran::lower::StatementContext localStatementCtx
;
1130 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1131 mlir::func::FuncOp ioFunc
= getIORuntimeFunc
<A
>(loc
, builder
);
1132 mlir::FunctionType ioFuncTy
= ioFunc
.getFunctionType();
1133 mlir::Value expr
= fir::getBase(converter
.genExprValue(
1134 loc
, Fortran::semantics::GetExpr(spec
.v
), localStatementCtx
));
1135 mlir::Value val
= builder
.createConvert(loc
, ioFuncTy
.getInput(1), expr
);
1136 llvm::SmallVector
<mlir::Value
> ioArgs
= {cookie
, val
};
1137 return builder
.create
<fir::CallOp
>(loc
, ioFunc
, ioArgs
).getResult(0);
1140 /// Generic to build a string argument to the runtime. This passes a CHARACTER
1141 /// as a pointer to the buffer and a LEN parameter.
1142 template <typename A
, typename B
>
1143 mlir::Value
genCharIOOption(Fortran::lower::AbstractConverter
&converter
,
1144 mlir::Location loc
, mlir::Value cookie
,
1146 Fortran::lower::StatementContext localStatementCtx
;
1147 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1148 mlir::func::FuncOp ioFunc
= getIORuntimeFunc
<A
>(loc
, builder
);
1149 mlir::FunctionType ioFuncTy
= ioFunc
.getFunctionType();
1150 std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
> tup
=
1151 lowerStringLit(converter
, loc
, localStatementCtx
, spec
,
1152 ioFuncTy
.getInput(1), ioFuncTy
.getInput(2));
1153 llvm::SmallVector
<mlir::Value
> ioArgs
= {cookie
, std::get
<0>(tup
),
1155 return builder
.create
<fir::CallOp
>(loc
, ioFunc
, ioArgs
).getResult(0);
1158 template <typename A
>
1159 mlir::Value
genIOOption(Fortran::lower::AbstractConverter
&converter
,
1160 mlir::Location loc
, mlir::Value cookie
, const A
&spec
) {
1161 // These specifiers are processed in advance elsewhere - skip them here.
1162 using PreprocessedSpecs
=
1163 std::tuple
<Fortran::parser::EndLabel
, Fortran::parser::EorLabel
,
1164 Fortran::parser::ErrLabel
, Fortran::parser::FileUnitNumber
,
1165 Fortran::parser::Format
, Fortran::parser::IoUnit
,
1166 Fortran::parser::MsgVariable
, Fortran::parser::Name
,
1167 Fortran::parser::StatVariable
>;
1168 static_assert(Fortran::common::HasMember
<A
, PreprocessedSpecs
>,
1169 "missing genIOOPtion specialization");
1174 mlir::Value genIOOption
<Fortran::parser::FileNameExpr
>(
1175 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1176 mlir::Value cookie
, const Fortran::parser::FileNameExpr
&spec
) {
1177 Fortran::lower::StatementContext localStatementCtx
;
1178 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1179 // has an extra KIND argument
1180 mlir::func::FuncOp ioFunc
= getIORuntimeFunc
<mkIOKey(SetFile
)>(loc
, builder
);
1181 mlir::FunctionType ioFuncTy
= ioFunc
.getFunctionType();
1182 std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
> tup
=
1183 lowerStringLit(converter
, loc
, localStatementCtx
, spec
,
1184 ioFuncTy
.getInput(1), ioFuncTy
.getInput(2));
1185 llvm::SmallVector
<mlir::Value
> ioArgs
{cookie
, std::get
<0>(tup
),
1187 return builder
.create
<fir::CallOp
>(loc
, ioFunc
, ioArgs
).getResult(0);
1191 mlir::Value genIOOption
<Fortran::parser::ConnectSpec::CharExpr
>(
1192 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1193 mlir::Value cookie
, const Fortran::parser::ConnectSpec::CharExpr
&spec
) {
1194 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1195 mlir::func::FuncOp ioFunc
;
1196 switch (std::get
<Fortran::parser::ConnectSpec::CharExpr::Kind
>(spec
.t
)) {
1197 case Fortran::parser::ConnectSpec::CharExpr::Kind::Access
:
1198 ioFunc
= getIORuntimeFunc
<mkIOKey(SetAccess
)>(loc
, builder
);
1200 case Fortran::parser::ConnectSpec::CharExpr::Kind::Action
:
1201 ioFunc
= getIORuntimeFunc
<mkIOKey(SetAction
)>(loc
, builder
);
1203 case Fortran::parser::ConnectSpec::CharExpr::Kind::Asynchronous
:
1204 ioFunc
= getIORuntimeFunc
<mkIOKey(SetAsynchronous
)>(loc
, builder
);
1206 case Fortran::parser::ConnectSpec::CharExpr::Kind::Blank
:
1207 ioFunc
= getIORuntimeFunc
<mkIOKey(SetBlank
)>(loc
, builder
);
1209 case Fortran::parser::ConnectSpec::CharExpr::Kind::Decimal
:
1210 ioFunc
= getIORuntimeFunc
<mkIOKey(SetDecimal
)>(loc
, builder
);
1212 case Fortran::parser::ConnectSpec::CharExpr::Kind::Delim
:
1213 ioFunc
= getIORuntimeFunc
<mkIOKey(SetDelim
)>(loc
, builder
);
1215 case Fortran::parser::ConnectSpec::CharExpr::Kind::Encoding
:
1216 ioFunc
= getIORuntimeFunc
<mkIOKey(SetEncoding
)>(loc
, builder
);
1218 case Fortran::parser::ConnectSpec::CharExpr::Kind::Form
:
1219 ioFunc
= getIORuntimeFunc
<mkIOKey(SetForm
)>(loc
, builder
);
1221 case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad
:
1222 ioFunc
= getIORuntimeFunc
<mkIOKey(SetPad
)>(loc
, builder
);
1224 case Fortran::parser::ConnectSpec::CharExpr::Kind::Position
:
1225 ioFunc
= getIORuntimeFunc
<mkIOKey(SetPosition
)>(loc
, builder
);
1227 case Fortran::parser::ConnectSpec::CharExpr::Kind::Round
:
1228 ioFunc
= getIORuntimeFunc
<mkIOKey(SetRound
)>(loc
, builder
);
1230 case Fortran::parser::ConnectSpec::CharExpr::Kind::Sign
:
1231 ioFunc
= getIORuntimeFunc
<mkIOKey(SetSign
)>(loc
, builder
);
1233 case Fortran::parser::ConnectSpec::CharExpr::Kind::Carriagecontrol
:
1234 ioFunc
= getIORuntimeFunc
<mkIOKey(SetCarriagecontrol
)>(loc
, builder
);
1236 case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert
:
1237 ioFunc
= getIORuntimeFunc
<mkIOKey(SetConvert
)>(loc
, builder
);
1239 case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose
:
1240 TODO(loc
, "DISPOSE not part of the runtime::io interface");
1242 Fortran::lower::StatementContext localStatementCtx
;
1243 mlir::FunctionType ioFuncTy
= ioFunc
.getFunctionType();
1244 std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
> tup
=
1245 lowerStringLit(converter
, loc
, localStatementCtx
,
1246 std::get
<Fortran::parser::ScalarDefaultCharExpr
>(spec
.t
),
1247 ioFuncTy
.getInput(1), ioFuncTy
.getInput(2));
1248 llvm::SmallVector
<mlir::Value
> ioArgs
= {cookie
, std::get
<0>(tup
),
1250 return builder
.create
<fir::CallOp
>(loc
, ioFunc
, ioArgs
).getResult(0);
1254 mlir::Value genIOOption
<Fortran::parser::ConnectSpec::Recl
>(
1255 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1256 mlir::Value cookie
, const Fortran::parser::ConnectSpec::Recl
&spec
) {
1257 return genIntIOOption
<mkIOKey(SetRecl
)>(converter
, loc
, cookie
, spec
);
1261 mlir::Value genIOOption
<Fortran::parser::StatusExpr
>(
1262 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1263 mlir::Value cookie
, const Fortran::parser::StatusExpr
&spec
) {
1264 return genCharIOOption
<mkIOKey(SetStatus
)>(converter
, loc
, cookie
, spec
.v
);
1268 mlir::Value genIOOption
<Fortran::parser::IoControlSpec::CharExpr
>(
1269 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1270 mlir::Value cookie
, const Fortran::parser::IoControlSpec::CharExpr
&spec
) {
1271 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1272 mlir::func::FuncOp ioFunc
;
1273 switch (std::get
<Fortran::parser::IoControlSpec::CharExpr::Kind
>(spec
.t
)) {
1274 case Fortran::parser::IoControlSpec::CharExpr::Kind::Advance
:
1275 ioFunc
= getIORuntimeFunc
<mkIOKey(SetAdvance
)>(loc
, builder
);
1277 case Fortran::parser::IoControlSpec::CharExpr::Kind::Blank
:
1278 ioFunc
= getIORuntimeFunc
<mkIOKey(SetBlank
)>(loc
, builder
);
1280 case Fortran::parser::IoControlSpec::CharExpr::Kind::Decimal
:
1281 ioFunc
= getIORuntimeFunc
<mkIOKey(SetDecimal
)>(loc
, builder
);
1283 case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim
:
1284 ioFunc
= getIORuntimeFunc
<mkIOKey(SetDelim
)>(loc
, builder
);
1286 case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad
:
1287 ioFunc
= getIORuntimeFunc
<mkIOKey(SetPad
)>(loc
, builder
);
1289 case Fortran::parser::IoControlSpec::CharExpr::Kind::Round
:
1290 ioFunc
= getIORuntimeFunc
<mkIOKey(SetRound
)>(loc
, builder
);
1292 case Fortran::parser::IoControlSpec::CharExpr::Kind::Sign
:
1293 ioFunc
= getIORuntimeFunc
<mkIOKey(SetSign
)>(loc
, builder
);
1296 Fortran::lower::StatementContext localStatementCtx
;
1297 mlir::FunctionType ioFuncTy
= ioFunc
.getFunctionType();
1298 std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
> tup
=
1299 lowerStringLit(converter
, loc
, localStatementCtx
,
1300 std::get
<Fortran::parser::ScalarDefaultCharExpr
>(spec
.t
),
1301 ioFuncTy
.getInput(1), ioFuncTy
.getInput(2));
1302 llvm::SmallVector
<mlir::Value
> ioArgs
= {cookie
, std::get
<0>(tup
),
1304 return builder
.create
<fir::CallOp
>(loc
, ioFunc
, ioArgs
).getResult(0);
1308 mlir::Value genIOOption
<Fortran::parser::IoControlSpec::Asynchronous
>(
1309 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1311 const Fortran::parser::IoControlSpec::Asynchronous
&spec
) {
1312 return genCharIOOption
<mkIOKey(SetAsynchronous
)>(converter
, loc
, cookie
,
1317 mlir::Value genIOOption
<Fortran::parser::IdVariable
>(
1318 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1319 mlir::Value cookie
, const Fortran::parser::IdVariable
&spec
) {
1320 TODO(loc
, "asynchronous ID not implemented");
1324 mlir::Value genIOOption
<Fortran::parser::IoControlSpec::Pos
>(
1325 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1326 mlir::Value cookie
, const Fortran::parser::IoControlSpec::Pos
&spec
) {
1327 return genIntIOOption
<mkIOKey(SetPos
)>(converter
, loc
, cookie
, spec
);
1331 mlir::Value genIOOption
<Fortran::parser::IoControlSpec::Rec
>(
1332 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1333 mlir::Value cookie
, const Fortran::parser::IoControlSpec::Rec
&spec
) {
1334 return genIntIOOption
<mkIOKey(SetRec
)>(converter
, loc
, cookie
, spec
);
1337 /// Generate runtime call to query the read size after an input statement if
1338 /// the statement has SIZE control-spec.
1339 template <typename A
>
1340 static void genIOReadSize(Fortran::lower::AbstractConverter
&converter
,
1341 mlir::Location loc
, mlir::Value cookie
,
1342 const A
&specList
, bool checkResult
) {
1343 // This call is not conditional on the current IO status (ok) because the size
1344 // needs to be filled even if some error condition (end-of-file...) was met
1345 // during the input statement (in which case the runtime may return zero for
1347 for (const auto &spec
: specList
)
1348 if (const auto *size
=
1349 std::get_if
<Fortran::parser::IoControlSpec::Size
>(&spec
.u
)) {
1351 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1352 mlir::func::FuncOp ioFunc
=
1353 getIORuntimeFunc
<mkIOKey(GetSize
)>(loc
, builder
);
1355 builder
.create
<fir::CallOp
>(loc
, ioFunc
, mlir::ValueRange
{cookie
})
1357 Fortran::lower::StatementContext localStatementCtx
;
1358 fir::ExtendedValue var
= converter
.genExprAddr(
1359 loc
, Fortran::semantics::GetExpr(size
->v
), localStatementCtx
);
1360 mlir::Value varAddr
= fir::getBase(var
);
1361 mlir::Type varType
= fir::unwrapPassByRefType(varAddr
.getType());
1362 mlir::Value sizeCast
= builder
.createConvert(loc
, varType
, sizeValue
);
1363 builder
.create
<fir::StoreOp
>(loc
, sizeCast
, varAddr
);
1368 //===----------------------------------------------------------------------===//
1369 // Gather IO statement condition specifier information (if any).
1370 //===----------------------------------------------------------------------===//
1372 template <typename SEEK
, typename A
>
1373 static bool hasX(const A
&list
) {
1374 for (const auto &spec
: list
)
1375 if (std::holds_alternative
<SEEK
>(spec
.u
))
1380 template <typename SEEK
, typename A
>
1381 static bool hasSpec(const A
&stmt
) {
1382 return hasX
<SEEK
>(stmt
.v
);
1385 /// Get the sought expression from the specifier list.
1386 template <typename SEEK
, typename A
>
1387 static const Fortran::lower::SomeExpr
*getExpr(const A
&stmt
) {
1388 for (const auto &spec
: stmt
.v
)
1389 if (auto *f
= std::get_if
<SEEK
>(&spec
.u
))
1390 return Fortran::semantics::GetExpr(f
->v
);
1391 llvm::report_fatal_error("must have a file unit");
1394 /// For each specifier, build the appropriate call, threading the cookie.
1395 template <typename A
>
1396 static void threadSpecs(Fortran::lower::AbstractConverter
&converter
,
1397 mlir::Location loc
, mlir::Value cookie
,
1398 const A
&specList
, bool checkResult
, mlir::Value
&ok
) {
1399 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1400 for (const auto &spec
: specList
) {
1401 makeNextConditionalOn(builder
, loc
, checkResult
, ok
);
1403 Fortran::common::visitors
{
1404 [&](const Fortran::parser::IoControlSpec::Size
&x
) -> mlir::Value
{
1405 // Size must be queried after the related READ runtime calls, not
1409 [&](const Fortran::parser::ConnectSpec::Newunit
&x
) -> mlir::Value
{
1410 // Newunit must be queried after OPEN specifier runtime calls
1411 // that may fail to avoid modifying the newunit variable if
1412 // there is an error.
1415 [&](const auto &x
) {
1416 return genIOOption(converter
, loc
, cookie
, x
);
1422 /// Most IO statements allow one or more of five optional exception condition
1423 /// handling specifiers: ERR, EOR, END, IOSTAT, and IOMSG. The first three
1424 /// cause control flow to transfer to another statement. The final two return
1425 /// information from the runtime, via a variable, about the nature of the
1426 /// condition that occurred. These condition specifiers are handled here.
1427 template <typename A
>
1428 ConditionSpecInfo
lowerErrorSpec(Fortran::lower::AbstractConverter
&converter
,
1429 mlir::Location loc
, const A
&specList
) {
1430 ConditionSpecInfo csi
;
1431 const Fortran::lower::SomeExpr
*ioMsgExpr
= nullptr;
1432 for (const auto &spec
: specList
) {
1434 Fortran::common::visitors
{
1435 [&](const Fortran::parser::StatVariable
&var
) {
1436 csi
.ioStatExpr
= Fortran::semantics::GetExpr(var
);
1438 [&](const Fortran::parser::InquireSpec::IntVar
&var
) {
1439 if (std::get
<Fortran::parser::InquireSpec::IntVar::Kind
>(var
.t
) ==
1440 Fortran::parser::InquireSpec::IntVar::Kind::Iostat
)
1441 csi
.ioStatExpr
= Fortran::semantics::GetExpr(
1442 std::get
<Fortran::parser::ScalarIntVariable
>(var
.t
));
1444 [&](const Fortran::parser::MsgVariable
&var
) {
1445 ioMsgExpr
= Fortran::semantics::GetExpr(var
);
1447 [&](const Fortran::parser::InquireSpec::CharVar
&var
) {
1448 if (std::get
<Fortran::parser::InquireSpec::CharVar::Kind
>(
1450 Fortran::parser::InquireSpec::CharVar::Kind::Iomsg
)
1451 ioMsgExpr
= Fortran::semantics::GetExpr(
1452 std::get
<Fortran::parser::ScalarDefaultCharVariable
>(
1455 [&](const Fortran::parser::EndLabel
&) { csi
.hasEnd
= true; },
1456 [&](const Fortran::parser::EorLabel
&) { csi
.hasEor
= true; },
1457 [&](const Fortran::parser::ErrLabel
&) { csi
.hasErr
= true; },
1458 [](const auto &) {}},
1462 // iomsg is a variable, its evaluation may require temps, but it cannot
1463 // itself be a temp, and it is ok to us a local statement context here.
1464 Fortran::lower::StatementContext stmtCtx
;
1465 csi
.ioMsg
= converter
.genExprAddr(loc
, ioMsgExpr
, stmtCtx
);
1470 template <typename A
>
1472 genConditionHandlerCall(Fortran::lower::AbstractConverter
&converter
,
1473 mlir::Location loc
, mlir::Value cookie
,
1474 const A
&specList
, ConditionSpecInfo
&csi
) {
1475 if (!csi
.hasAnyConditionSpec())
1477 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1478 mlir::func::FuncOp enableHandlers
=
1479 getIORuntimeFunc
<mkIOKey(EnableHandlers
)>(loc
, builder
);
1480 mlir::Type boolType
= enableHandlers
.getFunctionType().getInput(1);
1481 auto boolValue
= [&](bool specifierIsPresent
) {
1482 return builder
.create
<mlir::arith::ConstantOp
>(
1483 loc
, builder
.getIntegerAttr(boolType
, specifierIsPresent
));
1485 llvm::SmallVector
<mlir::Value
> ioArgs
= {cookie
,
1486 boolValue(csi
.ioStatExpr
!= nullptr),
1487 boolValue(csi
.hasErr
),
1488 boolValue(csi
.hasEnd
),
1489 boolValue(csi
.hasEor
),
1490 boolValue(csi
.ioMsg
.has_value())};
1491 builder
.create
<fir::CallOp
>(loc
, enableHandlers
, ioArgs
);
1494 //===----------------------------------------------------------------------===//
1495 // Data transfer helpers
1496 //===----------------------------------------------------------------------===//
1498 template <typename SEEK
, typename A
>
1499 static bool hasIOControl(const A
&stmt
) {
1500 return hasX
<SEEK
>(stmt
.controls
);
1503 template <typename SEEK
, typename A
>
1504 static const auto *getIOControl(const A
&stmt
) {
1505 for (const auto &spec
: stmt
.controls
)
1506 if (const auto *result
= std::get_if
<SEEK
>(&spec
.u
))
1508 return static_cast<const SEEK
*>(nullptr);
1511 /// Returns true iff the expression in the parse tree is not really a format but
1512 /// rather a namelist group.
1513 template <typename A
>
1514 static bool formatIsActuallyNamelist(const A
&format
) {
1515 if (auto *e
= std::get_if
<Fortran::parser::Expr
>(&format
.u
)) {
1516 auto *expr
= Fortran::semantics::GetExpr(*e
);
1517 if (const Fortran::semantics::Symbol
*y
=
1518 Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr
))
1519 return y
->has
<Fortran::semantics::NamelistDetails
>();
1524 template <typename A
>
1525 static bool isDataTransferFormatted(const A
&stmt
) {
1527 return !formatIsActuallyNamelist(*stmt
.format
);
1528 return hasIOControl
<Fortran::parser::Format
>(stmt
);
1531 constexpr bool isDataTransferFormatted
<Fortran::parser::PrintStmt
>(
1532 const Fortran::parser::PrintStmt
&) {
1533 return true; // PRINT is always formatted
1536 template <typename A
>
1537 static bool isDataTransferList(const A
&stmt
) {
1539 return std::holds_alternative
<Fortran::parser::Star
>(stmt
.format
->u
);
1540 if (auto *mem
= getIOControl
<Fortran::parser::Format
>(stmt
))
1541 return std::holds_alternative
<Fortran::parser::Star
>(mem
->u
);
1545 bool isDataTransferList
<Fortran::parser::PrintStmt
>(
1546 const Fortran::parser::PrintStmt
&stmt
) {
1547 return std::holds_alternative
<Fortran::parser::Star
>(
1548 std::get
<Fortran::parser::Format
>(stmt
.t
).u
);
1551 template <typename A
>
1552 static bool isDataTransferInternal(const A
&stmt
) {
1553 if (stmt
.iounit
.has_value())
1554 return std::holds_alternative
<Fortran::parser::Variable
>(stmt
.iounit
->u
);
1555 if (auto *unit
= getIOControl
<Fortran::parser::IoUnit
>(stmt
))
1556 return std::holds_alternative
<Fortran::parser::Variable
>(unit
->u
);
1560 constexpr bool isDataTransferInternal
<Fortran::parser::PrintStmt
>(
1561 const Fortran::parser::PrintStmt
&) {
1565 /// If the variable `var` is an array or of a KIND other than the default
1566 /// (normally 1), then a descriptor is required by the runtime IO API. This
1567 /// condition holds even in F77 sources.
1568 static std::optional
<fir::ExtendedValue
> getVariableBufferRequiredDescriptor(
1569 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1570 const Fortran::parser::Variable
&var
,
1571 Fortran::lower::StatementContext
&stmtCtx
) {
1572 fir::ExtendedValue varBox
=
1573 converter
.genExprBox(loc
, var
.typedExpr
->v
.value(), stmtCtx
);
1574 fir::KindTy defCharKind
= converter
.getKindMap().defaultCharacterKind();
1575 mlir::Value varAddr
= fir::getBase(varBox
);
1576 if (fir::factory::CharacterExprHelper::getCharacterOrSequenceKind(
1577 varAddr
.getType()) != defCharKind
)
1579 if (fir::factory::CharacterExprHelper::isArray(varAddr
.getType()))
1581 return std::nullopt
;
1584 template <typename A
>
1585 static std::optional
<fir::ExtendedValue
>
1586 maybeGetInternalIODescriptor(Fortran::lower::AbstractConverter
&converter
,
1587 mlir::Location loc
, const A
&stmt
,
1588 Fortran::lower::StatementContext
&stmtCtx
) {
1589 if (stmt
.iounit
.has_value())
1590 if (auto *var
= std::get_if
<Fortran::parser::Variable
>(&stmt
.iounit
->u
))
1591 return getVariableBufferRequiredDescriptor(converter
, loc
, *var
, stmtCtx
);
1592 if (auto *unit
= getIOControl
<Fortran::parser::IoUnit
>(stmt
))
1593 if (auto *var
= std::get_if
<Fortran::parser::Variable
>(&unit
->u
))
1594 return getVariableBufferRequiredDescriptor(converter
, loc
, *var
, stmtCtx
);
1595 return std::nullopt
;
1598 inline std::optional
<fir::ExtendedValue
>
1599 maybeGetInternalIODescriptor
<Fortran::parser::PrintStmt
>(
1600 Fortran::lower::AbstractConverter
&, mlir::Location loc
,
1601 const Fortran::parser::PrintStmt
&, Fortran::lower::StatementContext
&) {
1602 return std::nullopt
;
1605 template <typename A
>
1606 static bool isDataTransferAsynchronous(mlir::Location loc
, const A
&stmt
) {
1608 getIOControl
<Fortran::parser::IoControlSpec::Asynchronous
>(stmt
)) {
1609 // FIXME: should contain a string of YES or NO
1610 TODO(loc
, "asynchronous transfers not implemented in runtime");
1615 bool isDataTransferAsynchronous
<Fortran::parser::PrintStmt
>(
1616 mlir::Location
, const Fortran::parser::PrintStmt
&) {
1620 template <typename A
>
1621 static bool isDataTransferNamelist(const A
&stmt
) {
1623 return formatIsActuallyNamelist(*stmt
.format
);
1624 return hasIOControl
<Fortran::parser::Name
>(stmt
);
1627 constexpr bool isDataTransferNamelist
<Fortran::parser::PrintStmt
>(
1628 const Fortran::parser::PrintStmt
&) {
1632 /// Lowers a format statment that uses an assigned variable label reference as
1633 /// a select operation to allow for run-time selection of the format statement.
1634 static std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
>
1635 lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter
&converter
,
1637 const Fortran::lower::SomeExpr
&expr
,
1638 mlir::Type strTy
, mlir::Type lenTy
,
1639 Fortran::lower::StatementContext
&stmtCtx
) {
1640 // Create the requisite blocks to inline a selectOp.
1641 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1642 mlir::Block
*startBlock
= builder
.getBlock();
1643 mlir::Block
*endBlock
= startBlock
->splitBlock(builder
.getInsertionPoint());
1644 mlir::Block
*block
= startBlock
->splitBlock(builder
.getInsertionPoint());
1645 builder
.setInsertionPointToEnd(block
);
1647 llvm::SmallVector
<int64_t> indexList
;
1648 llvm::SmallVector
<mlir::Block
*> blockList
;
1650 auto symbol
= GetLastSymbol(&expr
);
1651 Fortran::lower::pft::LabelSet labels
;
1652 converter
.lookupLabelSet(*symbol
, labels
);
1654 for (auto label
: labels
) {
1655 indexList
.push_back(label
);
1656 auto *eval
= converter
.lookupLabel(label
);
1657 assert(eval
&& "Label is missing from the table");
1659 llvm::StringRef text
= toStringRef(eval
->position
);
1660 mlir::Value stringRef
;
1661 mlir::Value stringLen
;
1662 if (eval
->isA
<Fortran::parser::FormatStmt
>()) {
1663 assert(text
.contains('(') && "FORMAT is unexpectedly ill-formed");
1664 // This is a format statement, so extract the spec from the text.
1665 std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
> stringLit
=
1666 lowerSourceTextAsStringLit(converter
, loc
, text
, strTy
, lenTy
);
1667 stringRef
= std::get
<0>(stringLit
);
1668 stringLen
= std::get
<1>(stringLit
);
1670 // This is not a format statement, so use null.
1671 stringRef
= builder
.createConvert(
1673 builder
.createIntegerConstant(loc
, builder
.getIndexType(), 0));
1674 stringLen
= builder
.createIntegerConstant(loc
, lenTy
, 0);
1677 // Pass the format string reference and the string length out of the select
1679 llvm::SmallVector
<mlir::Value
> args
= {stringRef
, stringLen
};
1680 builder
.create
<mlir::cf::BranchOp
>(loc
, endBlock
, args
);
1682 // Add block to the list of cases and make a new one.
1683 blockList
.push_back(block
);
1684 block
= block
->splitBlock(builder
.getInsertionPoint());
1685 builder
.setInsertionPointToEnd(block
);
1688 // Create the unit case which should result in an error.
1689 auto *unitBlock
= block
->splitBlock(builder
.getInsertionPoint());
1690 builder
.setInsertionPointToEnd(unitBlock
);
1691 fir::runtime::genReportFatalUserError(
1693 "Assigned format variable '" + symbol
->name().ToString() +
1694 "' has not been assigned a valid format label");
1695 builder
.create
<fir::UnreachableOp
>(loc
);
1696 blockList
.push_back(unitBlock
);
1698 // Lower the selectOp.
1699 builder
.setInsertionPointToEnd(startBlock
);
1700 auto label
= fir::getBase(converter
.genExprValue(loc
, &expr
, stmtCtx
));
1701 builder
.create
<fir::SelectOp
>(loc
, label
, indexList
, blockList
);
1703 builder
.setInsertionPointToEnd(endBlock
);
1704 endBlock
->addArgument(strTy
, loc
);
1705 endBlock
->addArgument(lenTy
, loc
);
1707 // Handle and return the string reference and length selected by the selectOp.
1708 auto buff
= endBlock
->getArgument(0);
1709 auto len
= endBlock
->getArgument(1);
1711 return {buff
, len
, mlir::Value
{}};
1714 /// Generate a reference to a format string. There are four cases - a format
1715 /// statement label, a character format expression, an integer that holds the
1716 /// label of a format statement, and the * case. The first three are done here.
1717 /// The * case is done elsewhere.
1718 static std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
>
1719 genFormat(Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1720 const Fortran::parser::Format
&format
, mlir::Type strTy
,
1721 mlir::Type lenTy
, Fortran::lower::StatementContext
&stmtCtx
) {
1722 if (const auto *label
= std::get_if
<Fortran::parser::Label
>(&format
.u
)) {
1723 // format statement label
1724 auto eval
= converter
.lookupLabel(*label
);
1725 assert(eval
&& "FORMAT not found in PROCEDURE");
1726 return lowerSourceTextAsStringLit(
1727 converter
, loc
, toStringRef(eval
->position
), strTy
, lenTy
);
1729 const auto *pExpr
= std::get_if
<Fortran::parser::Expr
>(&format
.u
);
1730 assert(pExpr
&& "missing format expression");
1731 auto e
= Fortran::semantics::GetExpr(*pExpr
);
1732 if (Fortran::semantics::ExprHasTypeCategory(
1733 *e
, Fortran::common::TypeCategory::Character
)) {
1734 // character expression
1736 // Array: return address(descriptor) and no length (and no kind value).
1737 return {fir::getBase(converter
.genExprBox(loc
, *e
, stmtCtx
)),
1738 mlir::Value
{}, mlir::Value
{}};
1739 // Scalar: return address(format) and format length (and no kind value).
1740 return lowerStringLit(converter
, loc
, stmtCtx
, *pExpr
, strTy
, lenTy
);
1743 if (Fortran::semantics::ExprHasTypeCategory(
1744 *e
, Fortran::common::TypeCategory::Integer
) &&
1745 e
->Rank() == 0 && Fortran::evaluate::UnwrapWholeSymbolDataRef(*e
)) {
1746 // Treat as a scalar integer variable containing an ASSIGN label.
1747 return lowerReferenceAsStringSelect(converter
, loc
, *e
, strTy
, lenTy
,
1751 // Legacy extension: it is possible that `*e` is not a scalar INTEGER
1752 // variable containing a label value. The output appears to be the source text
1753 // that initialized the variable? Needs more investigatation.
1754 TODO(loc
, "io-control-spec contains a reference to a non-integer, "
1755 "non-scalar, or non-variable");
1758 template <typename A
>
1759 std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
>
1760 getFormat(Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1761 const A
&stmt
, mlir::Type strTy
, mlir::Type lenTy
,
1762 Fortran ::lower::StatementContext
&stmtCtx
) {
1763 if (stmt
.format
&& !formatIsActuallyNamelist(*stmt
.format
))
1764 return genFormat(converter
, loc
, *stmt
.format
, strTy
, lenTy
, stmtCtx
);
1765 return genFormat(converter
, loc
, *getIOControl
<Fortran::parser::Format
>(stmt
),
1766 strTy
, lenTy
, stmtCtx
);
1769 std::tuple
<mlir::Value
, mlir::Value
, mlir::Value
>
1770 getFormat
<Fortran::parser::PrintStmt
>(
1771 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1772 const Fortran::parser::PrintStmt
&stmt
, mlir::Type strTy
, mlir::Type lenTy
,
1773 Fortran::lower::StatementContext
&stmtCtx
) {
1774 return genFormat(converter
, loc
, std::get
<Fortran::parser::Format
>(stmt
.t
),
1775 strTy
, lenTy
, stmtCtx
);
1778 /// Get a buffer for an internal file data transfer.
1779 template <typename A
>
1780 std::tuple
<mlir::Value
, mlir::Value
>
1781 getBuffer(Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1782 const A
&stmt
, mlir::Type strTy
, mlir::Type lenTy
,
1783 Fortran::lower::StatementContext
&stmtCtx
) {
1784 const Fortran::parser::IoUnit
*iounit
=
1785 stmt
.iounit
? &*stmt
.iounit
: getIOControl
<Fortran::parser::IoUnit
>(stmt
);
1787 if (auto *var
= std::get_if
<Fortran::parser::Variable
>(&iounit
->u
))
1788 if (auto *expr
= Fortran::semantics::GetExpr(*var
))
1789 return genBuffer(converter
, loc
, *expr
, strTy
, lenTy
, stmtCtx
);
1790 llvm::report_fatal_error("failed to get IoUnit expr");
1793 static mlir::Value
genIOUnitNumber(Fortran::lower::AbstractConverter
&converter
,
1795 const Fortran::lower::SomeExpr
*iounit
,
1796 mlir::Type ty
, ConditionSpecInfo
&csi
,
1797 Fortran::lower::StatementContext
&stmtCtx
) {
1798 auto &builder
= converter
.getFirOpBuilder();
1799 auto rawUnit
= fir::getBase(converter
.genExprValue(loc
, iounit
, stmtCtx
));
1800 unsigned rawUnitWidth
=
1801 rawUnit
.getType().cast
<mlir::IntegerType
>().getWidth();
1802 unsigned runtimeArgWidth
= ty
.cast
<mlir::IntegerType
>().getWidth();
1803 // The IO runtime supports `int` unit numbers, if the unit number may
1804 // overflow when passed to the IO runtime, check that the unit number is
1805 // in range before calling the BeginXXX.
1806 if (rawUnitWidth
> runtimeArgWidth
) {
1807 mlir::func::FuncOp check
=
1809 ? getIORuntimeFunc
<mkIOKey(CheckUnitNumberInRange64
)>(loc
, builder
)
1810 : getIORuntimeFunc
<mkIOKey(CheckUnitNumberInRange128
)>(loc
,
1812 mlir::FunctionType funcTy
= check
.getFunctionType();
1813 llvm::SmallVector
<mlir::Value
> args
;
1814 args
.push_back(builder
.createConvert(loc
, funcTy
.getInput(0), rawUnit
));
1815 args
.push_back(builder
.createBool(loc
, csi
.hasErrorConditionSpec()));
1817 args
.push_back(builder
.createConvert(loc
, funcTy
.getInput(2),
1818 fir::getBase(*csi
.ioMsg
)));
1819 args
.push_back(builder
.createConvert(loc
, funcTy
.getInput(3),
1820 fir::getLen(*csi
.ioMsg
)));
1822 args
.push_back(builder
.createNullConstant(loc
, funcTy
.getInput(2)));
1824 fir::factory::createZeroValue(builder
, loc
, funcTy
.getInput(3)));
1826 mlir::Value file
= locToFilename(converter
, loc
, funcTy
.getInput(4));
1827 mlir::Value line
= locToLineNo(converter
, loc
, funcTy
.getInput(5));
1828 args
.push_back(file
);
1829 args
.push_back(line
);
1830 auto checkCall
= builder
.create
<fir::CallOp
>(loc
, check
, args
);
1831 if (csi
.hasErrorConditionSpec()) {
1832 mlir::Value iostat
= checkCall
.getResult(0);
1833 mlir::Type iostatTy
= iostat
.getType();
1834 mlir::Value zero
= fir::factory::createZeroValue(builder
, loc
, iostatTy
);
1835 mlir::Value unitIsOK
= builder
.create
<mlir::arith::CmpIOp
>(
1836 loc
, mlir::arith::CmpIPredicate::eq
, iostat
, zero
);
1837 auto ifOp
= builder
.create
<fir::IfOp
>(loc
, iostatTy
, unitIsOK
,
1838 /*withElseRegion=*/true);
1839 builder
.setInsertionPointToStart(&ifOp
.getElseRegion().front());
1840 builder
.create
<fir::ResultOp
>(loc
, iostat
);
1841 builder
.setInsertionPointToStart(&ifOp
.getThenRegion().front());
1842 stmtCtx
.pushScope();
1843 csi
.bigUnitIfOp
= ifOp
;
1846 return builder
.createConvert(loc
, ty
, rawUnit
);
1849 static mlir::Value
genIOUnit(Fortran::lower::AbstractConverter
&converter
,
1851 const Fortran::parser::IoUnit
*iounit
,
1852 mlir::Type ty
, ConditionSpecInfo
&csi
,
1853 Fortran::lower::StatementContext
&stmtCtx
,
1854 int defaultUnitNumber
) {
1855 auto &builder
= converter
.getFirOpBuilder();
1857 if (auto *e
= std::get_if
<Fortran::parser::FileUnitNumber
>(&iounit
->u
))
1858 return genIOUnitNumber(converter
, loc
, Fortran::semantics::GetExpr(*e
),
1860 return builder
.create
<mlir::arith::ConstantOp
>(
1861 loc
, builder
.getIntegerAttr(ty
, defaultUnitNumber
));
1864 template <typename A
>
1866 getIOUnit(Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1867 const A
&stmt
, mlir::Type ty
, ConditionSpecInfo
&csi
,
1868 Fortran::lower::StatementContext
&stmtCtx
, int defaultUnitNumber
) {
1869 const Fortran::parser::IoUnit
*iounit
=
1870 stmt
.iounit
? &*stmt
.iounit
: getIOControl
<Fortran::parser::IoUnit
>(stmt
);
1871 return genIOUnit(converter
, loc
, iounit
, ty
, csi
, stmtCtx
, defaultUnitNumber
);
1873 //===----------------------------------------------------------------------===//
1874 // Generators for each IO statement type.
1875 //===----------------------------------------------------------------------===//
1877 template <typename K
, typename S
>
1878 static mlir::Value
genBasicIOStmt(Fortran::lower::AbstractConverter
&converter
,
1880 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1881 Fortran::lower::StatementContext stmtCtx
;
1882 mlir::Location loc
= converter
.getCurrentLocation();
1883 ConditionSpecInfo csi
= lowerErrorSpec(converter
, loc
, stmt
.v
);
1884 mlir::func::FuncOp beginFunc
= getIORuntimeFunc
<K
>(loc
, builder
);
1885 mlir::FunctionType beginFuncTy
= beginFunc
.getFunctionType();
1886 mlir::Value unit
= genIOUnitNumber(
1887 converter
, loc
, getExpr
<Fortran::parser::FileUnitNumber
>(stmt
),
1888 beginFuncTy
.getInput(0), csi
, stmtCtx
);
1889 mlir::Value un
= builder
.createConvert(loc
, beginFuncTy
.getInput(0), unit
);
1890 mlir::Value file
= locToFilename(converter
, loc
, beginFuncTy
.getInput(1));
1891 mlir::Value line
= locToLineNo(converter
, loc
, beginFuncTy
.getInput(2));
1892 auto call
= builder
.create
<fir::CallOp
>(loc
, beginFunc
,
1893 mlir::ValueRange
{un
, file
, line
});
1894 mlir::Value cookie
= call
.getResult(0);
1895 genConditionHandlerCall(converter
, loc
, cookie
, stmt
.v
, csi
);
1897 auto insertPt
= builder
.saveInsertionPoint();
1898 threadSpecs(converter
, loc
, cookie
, stmt
.v
, csi
.hasErrorConditionSpec(), ok
);
1899 builder
.restoreInsertionPoint(insertPt
);
1900 return genEndIO(converter
, converter
.getCurrentLocation(), cookie
, csi
,
1904 mlir::Value
Fortran::lower::genBackspaceStatement(
1905 Fortran::lower::AbstractConverter
&converter
,
1906 const Fortran::parser::BackspaceStmt
&stmt
) {
1907 return genBasicIOStmt
<mkIOKey(BeginBackspace
)>(converter
, stmt
);
1910 mlir::Value
Fortran::lower::genEndfileStatement(
1911 Fortran::lower::AbstractConverter
&converter
,
1912 const Fortran::parser::EndfileStmt
&stmt
) {
1913 return genBasicIOStmt
<mkIOKey(BeginEndfile
)>(converter
, stmt
);
1917 Fortran::lower::genFlushStatement(Fortran::lower::AbstractConverter
&converter
,
1918 const Fortran::parser::FlushStmt
&stmt
) {
1919 return genBasicIOStmt
<mkIOKey(BeginFlush
)>(converter
, stmt
);
1923 Fortran::lower::genRewindStatement(Fortran::lower::AbstractConverter
&converter
,
1924 const Fortran::parser::RewindStmt
&stmt
) {
1925 return genBasicIOStmt
<mkIOKey(BeginRewind
)>(converter
, stmt
);
1929 genNewunitSpec(Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
1931 const std::list
<Fortran::parser::ConnectSpec
> &specList
) {
1932 for (const auto &spec
: specList
)
1934 std::get_if
<Fortran::parser::ConnectSpec::Newunit
>(&spec
.u
)) {
1935 Fortran::lower::StatementContext stmtCtx
;
1936 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1937 mlir::func::FuncOp ioFunc
=
1938 getIORuntimeFunc
<mkIOKey(GetNewUnit
)>(loc
, builder
);
1939 mlir::FunctionType ioFuncTy
= ioFunc
.getFunctionType();
1940 const auto *var
= Fortran::semantics::GetExpr(newunit
->v
);
1941 mlir::Value addr
= builder
.createConvert(
1942 loc
, ioFuncTy
.getInput(1),
1943 fir::getBase(converter
.genExprAddr(loc
, var
, stmtCtx
)));
1944 auto kind
= builder
.createIntegerConstant(loc
, ioFuncTy
.getInput(2),
1945 var
->GetType().value().kind());
1946 llvm::SmallVector
<mlir::Value
> ioArgs
= {cookie
, addr
, kind
};
1947 return builder
.create
<fir::CallOp
>(loc
, ioFunc
, ioArgs
).getResult(0);
1949 llvm_unreachable("missing Newunit spec");
1953 Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter
&converter
,
1954 const Fortran::parser::OpenStmt
&stmt
) {
1955 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
1956 Fortran::lower::StatementContext stmtCtx
;
1957 mlir::func::FuncOp beginFunc
;
1958 llvm::SmallVector
<mlir::Value
> beginArgs
;
1959 mlir::Location loc
= converter
.getCurrentLocation();
1960 ConditionSpecInfo csi
= lowerErrorSpec(converter
, loc
, stmt
.v
);
1961 bool hasNewunitSpec
= false;
1962 if (hasSpec
<Fortran::parser::FileUnitNumber
>(stmt
)) {
1963 beginFunc
= getIORuntimeFunc
<mkIOKey(BeginOpenUnit
)>(loc
, builder
);
1964 mlir::FunctionType beginFuncTy
= beginFunc
.getFunctionType();
1965 mlir::Value unit
= genIOUnitNumber(
1966 converter
, loc
, getExpr
<Fortran::parser::FileUnitNumber
>(stmt
),
1967 beginFuncTy
.getInput(0), csi
, stmtCtx
);
1968 beginArgs
.push_back(unit
);
1969 beginArgs
.push_back(locToFilename(converter
, loc
, beginFuncTy
.getInput(1)));
1970 beginArgs
.push_back(locToLineNo(converter
, loc
, beginFuncTy
.getInput(2)));
1972 hasNewunitSpec
= hasSpec
<Fortran::parser::ConnectSpec::Newunit
>(stmt
);
1973 assert(hasNewunitSpec
&& "missing unit specifier");
1974 beginFunc
= getIORuntimeFunc
<mkIOKey(BeginOpenNewUnit
)>(loc
, builder
);
1975 mlir::FunctionType beginFuncTy
= beginFunc
.getFunctionType();
1976 beginArgs
.push_back(locToFilename(converter
, loc
, beginFuncTy
.getInput(0)));
1977 beginArgs
.push_back(locToLineNo(converter
, loc
, beginFuncTy
.getInput(1)));
1980 builder
.create
<fir::CallOp
>(loc
, beginFunc
, beginArgs
).getResult(0);
1981 genConditionHandlerCall(converter
, loc
, cookie
, stmt
.v
, csi
);
1983 auto insertPt
= builder
.saveInsertionPoint();
1984 threadSpecs(converter
, loc
, cookie
, stmt
.v
, csi
.hasErrorConditionSpec(), ok
);
1986 genNewunitSpec(converter
, loc
, cookie
, stmt
.v
);
1987 builder
.restoreInsertionPoint(insertPt
);
1988 return genEndIO(converter
, loc
, cookie
, csi
, stmtCtx
);
1992 Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter
&converter
,
1993 const Fortran::parser::CloseStmt
&stmt
) {
1994 return genBasicIOStmt
<mkIOKey(BeginClose
)>(converter
, stmt
);
1998 Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter
&converter
,
1999 const Fortran::parser::WaitStmt
&stmt
) {
2000 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
2001 Fortran::lower::StatementContext stmtCtx
;
2002 mlir::Location loc
= converter
.getCurrentLocation();
2003 ConditionSpecInfo csi
= lowerErrorSpec(converter
, loc
, stmt
.v
);
2004 bool hasId
= hasSpec
<Fortran::parser::IdExpr
>(stmt
);
2005 mlir::func::FuncOp beginFunc
=
2006 hasId
? getIORuntimeFunc
<mkIOKey(BeginWait
)>(loc
, builder
)
2007 : getIORuntimeFunc
<mkIOKey(BeginWaitAll
)>(loc
, builder
);
2008 mlir::FunctionType beginFuncTy
= beginFunc
.getFunctionType();
2009 mlir::Value unit
= genIOUnitNumber(
2010 converter
, loc
, getExpr
<Fortran::parser::FileUnitNumber
>(stmt
),
2011 beginFuncTy
.getInput(0), csi
, stmtCtx
);
2012 llvm::SmallVector
<mlir::Value
> args
{unit
};
2014 mlir::Value id
= fir::getBase(converter
.genExprValue(
2015 loc
, getExpr
<Fortran::parser::IdExpr
>(stmt
), stmtCtx
));
2016 args
.push_back(builder
.createConvert(loc
, beginFuncTy
.getInput(1), id
));
2017 args
.push_back(locToFilename(converter
, loc
, beginFuncTy
.getInput(2)));
2018 args
.push_back(locToLineNo(converter
, loc
, beginFuncTy
.getInput(3)));
2020 args
.push_back(locToFilename(converter
, loc
, beginFuncTy
.getInput(1)));
2021 args
.push_back(locToLineNo(converter
, loc
, beginFuncTy
.getInput(2)));
2023 auto cookie
= builder
.create
<fir::CallOp
>(loc
, beginFunc
, args
).getResult(0);
2024 genConditionHandlerCall(converter
, loc
, cookie
, stmt
.v
, csi
);
2025 return genEndIO(converter
, converter
.getCurrentLocation(), cookie
, csi
,
2029 //===----------------------------------------------------------------------===//
2030 // Data transfer statements.
2032 // There are several dimensions to the API with regard to data transfer
2033 // statements that need to be considered.
2035 // - input (READ) vs. output (WRITE, PRINT)
2036 // - unformatted vs. formatted vs. list vs. namelist
2037 // - synchronous vs. asynchronous
2038 // - external vs. internal
2039 //===----------------------------------------------------------------------===//
2041 // Get the begin data transfer IO function to call for the given values.
2042 template <bool isInput
>
2044 getBeginDataTransferFunc(mlir::Location loc
, fir::FirOpBuilder
&builder
,
2045 bool isFormatted
, bool isListOrNml
, bool isInternal
,
2046 bool isInternalWithDesc
, bool isAsync
) {
2047 if constexpr (isInput
) {
2048 if (isFormatted
|| isListOrNml
) {
2050 if (isInternalWithDesc
) {
2052 return getIORuntimeFunc
<mkIOKey(BeginInternalArrayListInput
)>(
2054 return getIORuntimeFunc
<mkIOKey(BeginInternalArrayFormattedInput
)>(
2058 return getIORuntimeFunc
<mkIOKey(BeginInternalListInput
)>(loc
,
2060 return getIORuntimeFunc
<mkIOKey(BeginInternalFormattedInput
)>(loc
,
2064 return getIORuntimeFunc
<mkIOKey(BeginExternalListInput
)>(loc
, builder
);
2065 return getIORuntimeFunc
<mkIOKey(BeginExternalFormattedInput
)>(loc
,
2068 return getIORuntimeFunc
<mkIOKey(BeginUnformattedInput
)>(loc
, builder
);
2070 if (isFormatted
|| isListOrNml
) {
2072 if (isInternalWithDesc
) {
2074 return getIORuntimeFunc
<mkIOKey(BeginInternalArrayListOutput
)>(
2076 return getIORuntimeFunc
<mkIOKey(BeginInternalArrayFormattedOutput
)>(
2080 return getIORuntimeFunc
<mkIOKey(BeginInternalListOutput
)>(loc
,
2082 return getIORuntimeFunc
<mkIOKey(BeginInternalFormattedOutput
)>(loc
,
2086 return getIORuntimeFunc
<mkIOKey(BeginExternalListOutput
)>(loc
, builder
);
2087 return getIORuntimeFunc
<mkIOKey(BeginExternalFormattedOutput
)>(loc
,
2090 return getIORuntimeFunc
<mkIOKey(BeginUnformattedOutput
)>(loc
, builder
);
2094 /// Generate the arguments of a begin data transfer statement call.
2095 template <bool hasIOCtrl
, int defaultUnitNumber
, typename A
>
2096 void genBeginDataTransferCallArgs(
2097 llvm::SmallVectorImpl
<mlir::Value
> &ioArgs
,
2098 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
2099 const A
&stmt
, mlir::FunctionType ioFuncTy
, bool isFormatted
,
2100 bool isListOrNml
, [[maybe_unused
]] bool isInternal
,
2101 [[maybe_unused
]] bool isAsync
,
2102 const std::optional
<fir::ExtendedValue
> &descRef
, ConditionSpecInfo
&csi
,
2103 Fortran::lower::StatementContext
&stmtCtx
) {
2104 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
2105 auto maybeGetFormatArgs
= [&]() {
2106 if (!isFormatted
|| isListOrNml
)
2109 getFormat(converter
, loc
, stmt
, ioFuncTy
.getInput(ioArgs
.size()),
2110 ioFuncTy
.getInput(ioArgs
.size() + 1), stmtCtx
);
2111 mlir::Value address
= std::get
<0>(triple
);
2112 mlir::Value length
= std::get
<1>(triple
);
2114 // Scalar format: string arg + length arg; no format descriptor arg
2115 ioArgs
.push_back(address
); // format string
2116 ioArgs
.push_back(length
); // format length
2118 builder
.createNullConstant(loc
, ioFuncTy
.getInput(ioArgs
.size())));
2121 // Array format: no string arg, no length arg; format descriptor arg
2123 builder
.createNullConstant(loc
, ioFuncTy
.getInput(ioArgs
.size())));
2125 builder
.createNullConstant(loc
, ioFuncTy
.getInput(ioArgs
.size())));
2126 ioArgs
.push_back( // format descriptor
2127 builder
.createConvert(loc
, ioFuncTy
.getInput(ioArgs
.size()), address
));
2129 if constexpr (hasIOCtrl
) { // READ or WRITE
2131 // descriptor or scalar variable; maybe explicit format; scratch area
2133 mlir::Value desc
= builder
.createBox(loc
, *descRef
);
2135 builder
.createConvert(loc
, ioFuncTy
.getInput(ioArgs
.size()), desc
));
2137 std::tuple
<mlir::Value
, mlir::Value
> pair
=
2138 getBuffer(converter
, loc
, stmt
, ioFuncTy
.getInput(ioArgs
.size()),
2139 ioFuncTy
.getInput(ioArgs
.size() + 1), stmtCtx
);
2140 ioArgs
.push_back(std::get
<0>(pair
)); // scalar character variable
2141 ioArgs
.push_back(std::get
<1>(pair
)); // character length
2143 maybeGetFormatArgs();
2144 ioArgs
.push_back( // internal scratch area buffer
2145 getDefaultScratch(builder
, loc
, ioFuncTy
.getInput(ioArgs
.size())));
2146 ioArgs
.push_back( // buffer length
2147 getDefaultScratchLen(builder
, loc
, ioFuncTy
.getInput(ioArgs
.size())));
2148 } else { // external IO - maybe explicit format; unit
2150 TODO(loc
, "asynchronous");
2151 maybeGetFormatArgs();
2152 ioArgs
.push_back(getIOUnit(converter
, loc
, stmt
,
2153 ioFuncTy
.getInput(ioArgs
.size()), csi
, stmtCtx
,
2154 defaultUnitNumber
));
2156 } else { // PRINT - maybe explicit format; default unit
2157 maybeGetFormatArgs();
2158 ioArgs
.push_back(builder
.create
<mlir::arith::ConstantOp
>(
2159 loc
, builder
.getIntegerAttr(ioFuncTy
.getInput(ioArgs
.size()),
2160 defaultUnitNumber
)));
2162 // File name and line number are always the last two arguments.
2164 locToFilename(converter
, loc
, ioFuncTy
.getInput(ioArgs
.size())));
2166 locToLineNo(converter
, loc
, ioFuncTy
.getInput(ioArgs
.size())));
2169 template <bool isInput
, bool hasIOCtrl
= true, typename A
>
2171 genDataTransferStmt(Fortran::lower::AbstractConverter
&converter
,
2173 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
2174 Fortran::lower::StatementContext stmtCtx
;
2175 mlir::Location loc
= converter
.getCurrentLocation();
2176 const bool isFormatted
= isDataTransferFormatted(stmt
);
2177 const bool isList
= isFormatted
? isDataTransferList(stmt
) : false;
2178 const bool isInternal
= isDataTransferInternal(stmt
);
2179 std::optional
<fir::ExtendedValue
> descRef
=
2180 isInternal
? maybeGetInternalIODescriptor(converter
, loc
, stmt
, stmtCtx
)
2182 const bool isInternalWithDesc
= descRef
.has_value();
2183 const bool isAsync
= isDataTransferAsynchronous(loc
, stmt
);
2184 const bool isNml
= isDataTransferNamelist(stmt
);
2186 // Generate an EnableHandlers call and remaining specifier calls.
2187 ConditionSpecInfo csi
;
2188 if constexpr (hasIOCtrl
) {
2189 csi
= lowerErrorSpec(converter
, loc
, stmt
.controls
);
2192 // Generate the begin data transfer function call.
2193 mlir::func::FuncOp ioFunc
= getBeginDataTransferFunc
<isInput
>(
2194 loc
, builder
, isFormatted
, isList
|| isNml
, isInternal
,
2195 isInternalWithDesc
, isAsync
);
2196 llvm::SmallVector
<mlir::Value
> ioArgs
;
2197 genBeginDataTransferCallArgs
<
2198 hasIOCtrl
, isInput
? Fortran::runtime::io::DefaultInputUnit
2199 : Fortran::runtime::io::DefaultOutputUnit
>(
2200 ioArgs
, converter
, loc
, stmt
, ioFunc
.getFunctionType(), isFormatted
,
2201 isList
|| isNml
, isInternal
, isAsync
, descRef
, csi
, stmtCtx
);
2202 mlir::Value cookie
=
2203 builder
.create
<fir::CallOp
>(loc
, ioFunc
, ioArgs
).getResult(0);
2205 auto insertPt
= builder
.saveInsertionPoint();
2207 if constexpr (hasIOCtrl
) {
2208 genConditionHandlerCall(converter
, loc
, cookie
, stmt
.controls
, csi
);
2209 threadSpecs(converter
, loc
, cookie
, stmt
.controls
,
2210 csi
.hasErrorConditionSpec(), ok
);
2213 // Generate data transfer list calls.
2214 if constexpr (isInput
) { // READ
2216 genNamelistIO(converter
, cookie
,
2217 getIORuntimeFunc
<mkIOKey(InputNamelist
)>(loc
, builder
),
2218 *getIOControl
<Fortran::parser::Name
>(stmt
)->symbol
,
2219 csi
.hasTransferConditionSpec(), ok
, stmtCtx
);
2221 genInputItemList(converter
, cookie
, stmt
.items
, isFormatted
,
2222 csi
.hasTransferConditionSpec(), ok
, /*inLoop=*/false);
2223 } else if constexpr (std::is_same_v
<A
, Fortran::parser::WriteStmt
>) {
2225 genNamelistIO(converter
, cookie
,
2226 getIORuntimeFunc
<mkIOKey(OutputNamelist
)>(loc
, builder
),
2227 *getIOControl
<Fortran::parser::Name
>(stmt
)->symbol
,
2228 csi
.hasTransferConditionSpec(), ok
, stmtCtx
);
2230 genOutputItemList(converter
, cookie
, stmt
.items
, isFormatted
,
2231 csi
.hasTransferConditionSpec(), ok
,
2234 genOutputItemList(converter
, cookie
, std::get
<1>(stmt
.t
), isFormatted
,
2235 csi
.hasTransferConditionSpec(), ok
,
2239 builder
.restoreInsertionPoint(insertPt
);
2240 if constexpr (hasIOCtrl
) {
2241 genIOReadSize(converter
, loc
, cookie
, stmt
.controls
,
2242 csi
.hasErrorConditionSpec());
2244 // Generate end statement call/s.
2245 mlir::Value result
= genEndIO(converter
, loc
, cookie
, csi
, stmtCtx
);
2246 stmtCtx
.finalizeAndReset();
2250 void Fortran::lower::genPrintStatement(
2251 Fortran::lower::AbstractConverter
&converter
,
2252 const Fortran::parser::PrintStmt
&stmt
) {
2253 // PRINT does not take an io-control-spec. It only has a format specifier, so
2254 // it is a simplified case of WRITE.
2255 genDataTransferStmt
</*isInput=*/false, /*ioCtrl=*/false>(converter
, stmt
);
2259 Fortran::lower::genWriteStatement(Fortran::lower::AbstractConverter
&converter
,
2260 const Fortran::parser::WriteStmt
&stmt
) {
2261 return genDataTransferStmt
</*isInput=*/false>(converter
, stmt
);
2265 Fortran::lower::genReadStatement(Fortran::lower::AbstractConverter
&converter
,
2266 const Fortran::parser::ReadStmt
&stmt
) {
2267 return genDataTransferStmt
</*isInput=*/true>(converter
, stmt
);
2270 /// Get the file expression from the inquire spec list. Also return if the
2271 /// expression is a file name.
2272 static std::pair
<const Fortran::lower::SomeExpr
*, bool>
2273 getInquireFileExpr(const std::list
<Fortran::parser::InquireSpec
> *stmt
) {
2275 return {nullptr, /*filename?=*/false};
2276 for (const Fortran::parser::InquireSpec
&spec
: *stmt
) {
2277 if (auto *f
= std::get_if
<Fortran::parser::FileUnitNumber
>(&spec
.u
))
2278 return {Fortran::semantics::GetExpr(*f
), /*filename?=*/false};
2279 if (auto *f
= std::get_if
<Fortran::parser::FileNameExpr
>(&spec
.u
))
2280 return {Fortran::semantics::GetExpr(*f
), /*filename?=*/true};
2282 // semantics should have already caught this condition
2283 llvm::report_fatal_error("inquire spec must have a file");
2286 /// Generate calls to the four distinct INQUIRE subhandlers. An INQUIRE may
2287 /// return values of type CHARACTER, INTEGER, or LOGICAL. There is one
2288 /// additional special case for INQUIRE with both PENDING and ID specifiers.
2289 template <typename A
>
2290 static mlir::Value
genInquireSpec(Fortran::lower::AbstractConverter
&converter
,
2291 mlir::Location loc
, mlir::Value cookie
,
2292 mlir::Value idExpr
, const A
&var
,
2293 Fortran::lower::StatementContext
&stmtCtx
) {
2294 // default case: do nothing
2297 /// Specialization for CHARACTER.
2299 mlir::Value genInquireSpec
<Fortran::parser::InquireSpec::CharVar
>(
2300 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
2301 mlir::Value cookie
, mlir::Value idExpr
,
2302 const Fortran::parser::InquireSpec::CharVar
&var
,
2303 Fortran::lower::StatementContext
&stmtCtx
) {
2304 // IOMSG is handled with exception conditions
2305 if (std::get
<Fortran::parser::InquireSpec::CharVar::Kind
>(var
.t
) ==
2306 Fortran::parser::InquireSpec::CharVar::Kind::Iomsg
)
2308 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
2309 mlir::func::FuncOp specFunc
=
2310 getIORuntimeFunc
<mkIOKey(InquireCharacter
)>(loc
, builder
);
2311 mlir::FunctionType specFuncTy
= specFunc
.getFunctionType();
2312 const auto *varExpr
= Fortran::semantics::GetExpr(
2313 std::get
<Fortran::parser::ScalarDefaultCharVariable
>(var
.t
));
2314 fir::ExtendedValue str
= converter
.genExprAddr(loc
, varExpr
, stmtCtx
);
2315 llvm::SmallVector
<mlir::Value
> args
= {
2316 builder
.createConvert(loc
, specFuncTy
.getInput(0), cookie
),
2317 builder
.createIntegerConstant(
2318 loc
, specFuncTy
.getInput(1),
2319 Fortran::runtime::io::HashInquiryKeyword(std::string
{
2320 Fortran::parser::InquireSpec::CharVar::EnumToString(
2321 std::get
<Fortran::parser::InquireSpec::CharVar::Kind
>(var
.t
))}
2323 builder
.createConvert(loc
, specFuncTy
.getInput(2), fir::getBase(str
)),
2324 builder
.createConvert(loc
, specFuncTy
.getInput(3), fir::getLen(str
))};
2325 return builder
.create
<fir::CallOp
>(loc
, specFunc
, args
).getResult(0);
2327 /// Specialization for INTEGER.
2329 mlir::Value genInquireSpec
<Fortran::parser::InquireSpec::IntVar
>(
2330 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
2331 mlir::Value cookie
, mlir::Value idExpr
,
2332 const Fortran::parser::InquireSpec::IntVar
&var
,
2333 Fortran::lower::StatementContext
&stmtCtx
) {
2334 // IOSTAT is handled with exception conditions
2335 if (std::get
<Fortran::parser::InquireSpec::IntVar::Kind
>(var
.t
) ==
2336 Fortran::parser::InquireSpec::IntVar::Kind::Iostat
)
2338 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
2339 mlir::func::FuncOp specFunc
=
2340 getIORuntimeFunc
<mkIOKey(InquireInteger64
)>(loc
, builder
);
2341 mlir::FunctionType specFuncTy
= specFunc
.getFunctionType();
2342 const auto *varExpr
= Fortran::semantics::GetExpr(
2343 std::get
<Fortran::parser::ScalarIntVariable
>(var
.t
));
2344 mlir::Value addr
= fir::getBase(converter
.genExprAddr(loc
, varExpr
, stmtCtx
));
2345 mlir::Type eleTy
= fir::dyn_cast_ptrEleTy(addr
.getType());
2347 fir::emitFatalError(loc
,
2348 "internal error: expected a memory reference type");
2349 auto width
= eleTy
.cast
<mlir::IntegerType
>().getWidth();
2350 mlir::IndexType idxTy
= builder
.getIndexType();
2351 mlir::Value kind
= builder
.createIntegerConstant(loc
, idxTy
, width
/ 8);
2352 llvm::SmallVector
<mlir::Value
> args
= {
2353 builder
.createConvert(loc
, specFuncTy
.getInput(0), cookie
),
2354 builder
.createIntegerConstant(
2355 loc
, specFuncTy
.getInput(1),
2356 Fortran::runtime::io::HashInquiryKeyword(std::string
{
2357 Fortran::parser::InquireSpec::IntVar::EnumToString(
2358 std::get
<Fortran::parser::InquireSpec::IntVar::Kind
>(var
.t
))}
2360 builder
.createConvert(loc
, specFuncTy
.getInput(2), addr
),
2361 builder
.createConvert(loc
, specFuncTy
.getInput(3), kind
)};
2362 return builder
.create
<fir::CallOp
>(loc
, specFunc
, args
).getResult(0);
2364 /// Specialization for LOGICAL and (PENDING + ID).
2366 mlir::Value genInquireSpec
<Fortran::parser::InquireSpec::LogVar
>(
2367 Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
2368 mlir::Value cookie
, mlir::Value idExpr
,
2369 const Fortran::parser::InquireSpec::LogVar
&var
,
2370 Fortran::lower::StatementContext
&stmtCtx
) {
2371 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
2372 auto logVarKind
= std::get
<Fortran::parser::InquireSpec::LogVar::Kind
>(var
.t
);
2375 logVarKind
== Fortran::parser::InquireSpec::LogVar::Kind::Pending
;
2376 mlir::func::FuncOp specFunc
=
2377 pendId
? getIORuntimeFunc
<mkIOKey(InquirePendingId
)>(loc
, builder
)
2378 : getIORuntimeFunc
<mkIOKey(InquireLogical
)>(loc
, builder
);
2379 mlir::FunctionType specFuncTy
= specFunc
.getFunctionType();
2380 mlir::Value addr
= fir::getBase(converter
.genExprAddr(
2382 Fortran::semantics::GetExpr(
2383 std::get
<Fortran::parser::Scalar
<
2384 Fortran::parser::Logical
<Fortran::parser::Variable
>>>(var
.t
)),
2386 llvm::SmallVector
<mlir::Value
> args
= {
2387 builder
.createConvert(loc
, specFuncTy
.getInput(0), cookie
)};
2389 args
.push_back(builder
.createConvert(loc
, specFuncTy
.getInput(1), idExpr
));
2391 args
.push_back(builder
.createIntegerConstant(
2392 loc
, specFuncTy
.getInput(1),
2393 Fortran::runtime::io::HashInquiryKeyword(std::string
{
2394 Fortran::parser::InquireSpec::LogVar::EnumToString(logVarKind
)}
2396 args
.push_back(builder
.createConvert(loc
, specFuncTy
.getInput(2), addr
));
2397 auto call
= builder
.create
<fir::CallOp
>(loc
, specFunc
, args
);
2398 boolRefToLogical(loc
, builder
, addr
);
2399 return call
.getResult(0);
2402 /// If there is an IdExpr in the list of inquire-specs, then lower it and return
2403 /// the resulting Value. Otherwise, return null.
2405 lowerIdExpr(Fortran::lower::AbstractConverter
&converter
, mlir::Location loc
,
2406 const std::list
<Fortran::parser::InquireSpec
> &ispecs
,
2407 Fortran::lower::StatementContext
&stmtCtx
) {
2408 for (const Fortran::parser::InquireSpec
&spec
: ispecs
)
2409 if (mlir::Value v
= std::visit(
2410 Fortran::common::visitors
{
2411 [&](const Fortran::parser::IdExpr
&idExpr
) {
2412 return fir::getBase(converter
.genExprValue(
2413 loc
, Fortran::semantics::GetExpr(idExpr
), stmtCtx
));
2415 [](const auto &) { return mlir::Value
{}; }},
2421 /// For each inquire-spec, build the appropriate call, threading the cookie.
2422 static void threadInquire(Fortran::lower::AbstractConverter
&converter
,
2423 mlir::Location loc
, mlir::Value cookie
,
2424 const std::list
<Fortran::parser::InquireSpec
> &ispecs
,
2425 bool checkResult
, mlir::Value
&ok
,
2426 Fortran::lower::StatementContext
&stmtCtx
) {
2427 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
2428 mlir::Value idExpr
= lowerIdExpr(converter
, loc
, ispecs
, stmtCtx
);
2429 for (const Fortran::parser::InquireSpec
&spec
: ispecs
) {
2430 makeNextConditionalOn(builder
, loc
, checkResult
, ok
);
2431 ok
= std::visit(Fortran::common::visitors
{[&](const auto &x
) {
2432 return genInquireSpec(converter
, loc
, cookie
, idExpr
, x
,
2439 mlir::Value
Fortran::lower::genInquireStatement(
2440 Fortran::lower::AbstractConverter
&converter
,
2441 const Fortran::parser::InquireStmt
&stmt
) {
2442 fir::FirOpBuilder
&builder
= converter
.getFirOpBuilder();
2443 Fortran::lower::StatementContext stmtCtx
;
2444 mlir::Location loc
= converter
.getCurrentLocation();
2445 mlir::func::FuncOp beginFunc
;
2446 llvm::SmallVector
<mlir::Value
> beginArgs
;
2448 std::get_if
<std::list
<Fortran::parser::InquireSpec
>>(&stmt
.u
);
2449 auto exprPair
= getInquireFileExpr(list
);
2450 auto inquireFileUnit
= [&]() -> bool {
2451 return exprPair
.first
&& !exprPair
.second
;
2453 auto inquireFileName
= [&]() -> bool {
2454 return exprPair
.first
&& exprPair
.second
;
2457 ConditionSpecInfo csi
=
2458 list
? lowerErrorSpec(converter
, loc
, *list
) : ConditionSpecInfo
{};
2460 // Make one of three BeginInquire calls.
2461 if (inquireFileUnit()) {
2462 // Inquire by unit -- [UNIT=]file-unit-number.
2463 beginFunc
= getIORuntimeFunc
<mkIOKey(BeginInquireUnit
)>(loc
, builder
);
2464 mlir::FunctionType beginFuncTy
= beginFunc
.getFunctionType();
2465 mlir::Value unit
= genIOUnitNumber(converter
, loc
, exprPair
.first
,
2466 beginFuncTy
.getInput(0), csi
, stmtCtx
);
2467 beginArgs
= {unit
, locToFilename(converter
, loc
, beginFuncTy
.getInput(1)),
2468 locToLineNo(converter
, loc
, beginFuncTy
.getInput(2))};
2469 } else if (inquireFileName()) {
2470 // Inquire by file -- FILE=file-name-expr.
2471 beginFunc
= getIORuntimeFunc
<mkIOKey(BeginInquireFile
)>(loc
, builder
);
2472 mlir::FunctionType beginFuncTy
= beginFunc
.getFunctionType();
2473 fir::ExtendedValue file
=
2474 converter
.genExprAddr(loc
, exprPair
.first
, stmtCtx
);
2476 builder
.createConvert(loc
, beginFuncTy
.getInput(0), fir::getBase(file
)),
2477 builder
.createConvert(loc
, beginFuncTy
.getInput(1), fir::getLen(file
)),
2478 locToFilename(converter
, loc
, beginFuncTy
.getInput(2)),
2479 locToLineNo(converter
, loc
, beginFuncTy
.getInput(3))};
2481 // Inquire by output list -- IOLENGTH=scalar-int-variable.
2482 const auto *ioLength
=
2483 std::get_if
<Fortran::parser::InquireStmt::Iolength
>(&stmt
.u
);
2484 assert(ioLength
&& "must have an IOLENGTH specifier");
2485 beginFunc
= getIORuntimeFunc
<mkIOKey(BeginInquireIoLength
)>(loc
, builder
);
2486 mlir::FunctionType beginFuncTy
= beginFunc
.getFunctionType();
2487 beginArgs
= {locToFilename(converter
, loc
, beginFuncTy
.getInput(0)),
2488 locToLineNo(converter
, loc
, beginFuncTy
.getInput(1))};
2490 builder
.create
<fir::CallOp
>(loc
, beginFunc
, beginArgs
).getResult(0);
2494 std::get
<std::list
<Fortran::parser::OutputItem
>>(ioLength
->t
),
2495 /*isFormatted=*/false, /*checkResult=*/false, ok
, /*inLoop=*/false);
2496 auto *ioLengthVar
= Fortran::semantics::GetExpr(
2497 std::get
<Fortran::parser::ScalarIntVariable
>(ioLength
->t
));
2498 mlir::Value ioLengthVarAddr
=
2499 fir::getBase(converter
.genExprAddr(loc
, ioLengthVar
, stmtCtx
));
2500 llvm::SmallVector
<mlir::Value
> args
= {cookie
};
2501 mlir::Value length
=
2503 .create
<fir::CallOp
>(
2504 loc
, getIORuntimeFunc
<mkIOKey(GetIoLength
)>(loc
, builder
), args
)
2506 mlir::Value length1
=
2507 builder
.createConvert(loc
, converter
.genType(*ioLengthVar
), length
);
2508 builder
.create
<fir::StoreOp
>(loc
, length1
, ioLengthVarAddr
);
2509 return genEndIO(converter
, loc
, cookie
, csi
, stmtCtx
);
2512 // Common handling for inquire by unit or file.
2513 assert(list
&& "inquire-spec list must be present");
2515 builder
.create
<fir::CallOp
>(loc
, beginFunc
, beginArgs
).getResult(0);
2516 genConditionHandlerCall(converter
, loc
, cookie
, *list
, csi
);
2517 // Handle remaining arguments in specifier list.
2519 auto insertPt
= builder
.saveInsertionPoint();
2520 threadInquire(converter
, loc
, cookie
, *list
, csi
.hasErrorConditionSpec(), ok
,
2522 builder
.restoreInsertionPoint(insertPt
);
2523 // Generate end statement call.
2524 return genEndIO(converter
, loc
, cookie
, csi
, stmtCtx
);