Skip to content

Commit 7e32cad

Browse files
clementvaljeanPerier
clementval
and
jeanPerier
committed
[flang] Lower inquire statement
This patch adds the lowering of the `inquire` statement. This patch is part of the upstreaming effort from fir-dev branch. Depends on D120822 Reviewed By: schweitz Differential Revision: https://reviews.llvm.org/D120823 Co-authored-by: Jean Perier <[email protected]>
1 parent 46f46a3 commit 7e32cad

File tree

7 files changed

+336
-2
lines changed

7 files changed

+336
-2
lines changed

‎flang/include/flang/Lower/IO.h

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ struct BackspaceStmt;
2323
struct CloseStmt;
2424
struct EndfileStmt;
2525
struct FlushStmt;
26+
struct InquireStmt;
2627
struct OpenStmt;
2728
struct ReadStmt;
2829
struct RewindStmt;
@@ -49,6 +50,10 @@ mlir::Value genEndfileStatement(AbstractConverter &,
4950
/// Generate IO call(s) for FLUSH; return the IOSTAT code
5051
mlir::Value genFlushStatement(AbstractConverter &, const parser::FlushStmt &);
5152

53+
/// Generate IO call(s) for INQUIRE; return the IOSTAT code
54+
mlir::Value genInquireStatement(AbstractConverter &,
55+
const parser::InquireStmt &);
56+
5257
/// Generate IO call(s) for READ; return the IOSTAT code
5358
mlir::Value genReadStatement(AbstractConverter &converter,
5459
const parser::ReadStmt &stmt);

‎flang/include/flang/Optimizer/Builder/Character.h

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -107,6 +107,10 @@ class CharacterExprHelper {
107107
/// Extract the kind of a character or array of character type.
108108
static fir::KindTy getCharacterOrSequenceKind(mlir::Type type);
109109

110+
/// Determine the inner character type. Unwraps references, boxes, and
111+
/// sequences to find the !fir.char element type.
112+
static fir::CharacterType getCharType(mlir::Type type);
113+
110114
/// Determine the base character type
111115
static fir::CharacterType getCharacterType(mlir::Type type);
112116
static fir::CharacterType getCharacterType(const fir::CharBoxValue &box);

‎flang/lib/Lower/Bridge.cpp

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -831,7 +831,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
831831
}
832832

833833
void genFIR(const Fortran::parser::InquireStmt &stmt) {
834-
TODO(toLocation(), "InquireStmt lowering");
834+
mlir::Value iostat = genInquireStatement(*this, stmt);
835+
if (const auto *specs =
836+
std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u))
837+
genIoConditionBranches(getEval(), *specs, iostat);
835838
}
836839

837840
void genFIR(const Fortran::parser::OpenStmt &stmt) {

‎flang/lib/Lower/ConvertExpr.cpp

Lines changed: 25 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2484,7 +2484,31 @@ class ArrayExprLowering {
24842484
if (destShape.empty())
24852485
destShape = getShape(arrayOperands.back());
24862486
if (isBoxValue()) {
2487-
TODO(loc, "genarr BoxValue");
2487+
// Semantics are a reference to a boxed array.
2488+
// This case just requires that an embox operation be created to box the
2489+
// value. The value of the box is forwarded in the continuation.
2490+
mlir::Type reduceTy = reduceRank(arrTy, slice);
2491+
auto boxTy = fir::BoxType::get(reduceTy);
2492+
if (components.substring) {
2493+
// Adjust char length to substring size.
2494+
fir::CharacterType charTy =
2495+
fir::factory::CharacterExprHelper::getCharType(reduceTy);
2496+
auto seqTy = reduceTy.cast<fir::SequenceType>();
2497+
// TODO: Use a constant for fir.char LEN if we can compute it.
2498+
boxTy = fir::BoxType::get(
2499+
fir::SequenceType::get(fir::CharacterType::getUnknownLen(
2500+
builder.getContext(), charTy.getFKind()),
2501+
seqTy.getDimension()));
2502+
}
2503+
mlir::Value embox =
2504+
memref.getType().isa<fir::BoxType>()
2505+
? builder.create<fir::ReboxOp>(loc, boxTy, memref, shape, slice)
2506+
.getResult()
2507+
: builder
2508+
.create<fir::EmboxOp>(loc, boxTy, memref, shape, slice,
2509+
fir::getTypeParams(extMemref))
2510+
.getResult();
2511+
return [=](IterSpace) -> ExtValue { return fir::BoxValue(embox); };
24882512
}
24892513
if (isReferentiallyOpaque()) {
24902514
TODO(loc, "genarr isReferentiallyOpaque");

‎flang/lib/Lower/IO.cpp

Lines changed: 254 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1829,3 +1829,257 @@ Fortran::lower::genReadStatement(Fortran::lower::AbstractConverter &converter,
18291829
const Fortran::parser::ReadStmt &stmt) {
18301830
return genDataTransferStmt</*isInput=*/true>(converter, stmt);
18311831
}
1832+
1833+
/// Get the file expression from the inquire spec list. Also return if the
1834+
/// expression is a file name.
1835+
static std::pair<const Fortran::lower::SomeExpr *, bool>
1836+
getInquireFileExpr(const std::list<Fortran::parser::InquireSpec> *stmt) {
1837+
if (!stmt)
1838+
return {nullptr, /*filename?=*/false};
1839+
for (const Fortran::parser::InquireSpec &spec : *stmt) {
1840+
if (auto *f = std::get_if<Fortran::parser::FileUnitNumber>(&spec.u))
1841+
return {Fortran::semantics::GetExpr(*f), /*filename?=*/false};
1842+
if (auto *f = std::get_if<Fortran::parser::FileNameExpr>(&spec.u))
1843+
return {Fortran::semantics::GetExpr(*f), /*filename?=*/true};
1844+
}
1845+
// semantics should have already caught this condition
1846+
llvm::report_fatal_error("inquire spec must have a file");
1847+
}
1848+
1849+
/// Generate calls to the four distinct INQUIRE subhandlers. An INQUIRE may
1850+
/// return values of type CHARACTER, INTEGER, or LOGICAL. There is one
1851+
/// additional special case for INQUIRE with both PENDING and ID specifiers.
1852+
template <typename A>
1853+
static mlir::Value genInquireSpec(Fortran::lower::AbstractConverter &converter,
1854+
mlir::Location loc, mlir::Value cookie,
1855+
mlir::Value idExpr, const A &var,
1856+
Fortran::lower::StatementContext &stmtCtx) {
1857+
// default case: do nothing
1858+
return {};
1859+
}
1860+
/// Specialization for CHARACTER.
1861+
template <>
1862+
mlir::Value genInquireSpec<Fortran::parser::InquireSpec::CharVar>(
1863+
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
1864+
mlir::Value cookie, mlir::Value idExpr,
1865+
const Fortran::parser::InquireSpec::CharVar &var,
1866+
Fortran::lower::StatementContext &stmtCtx) {
1867+
// IOMSG is handled with exception conditions
1868+
if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t) ==
1869+
Fortran::parser::InquireSpec::CharVar::Kind::Iomsg)
1870+
return {};
1871+
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
1872+
mlir::FuncOp specFunc =
1873+
getIORuntimeFunc<mkIOKey(InquireCharacter)>(loc, builder);
1874+
mlir::FunctionType specFuncTy = specFunc.getType();
1875+
const auto *varExpr = Fortran::semantics::GetExpr(
1876+
std::get<Fortran::parser::ScalarDefaultCharVariable>(var.t));
1877+
fir::ExtendedValue str = converter.genExprAddr(varExpr, stmtCtx, loc);
1878+
llvm::SmallVector<mlir::Value> args = {
1879+
builder.createConvert(loc, specFuncTy.getInput(0), cookie),
1880+
builder.createIntegerConstant(
1881+
loc, specFuncTy.getInput(1),
1882+
Fortran::runtime::io::HashInquiryKeyword(
1883+
Fortran::parser::InquireSpec::CharVar::EnumToString(
1884+
std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t))
1885+
.c_str())),
1886+
builder.createConvert(loc, specFuncTy.getInput(2), fir::getBase(str)),
1887+
builder.createConvert(loc, specFuncTy.getInput(3), fir::getLen(str))};
1888+
return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
1889+
}
1890+
/// Specialization for INTEGER.
1891+
template <>
1892+
mlir::Value genInquireSpec<Fortran::parser::InquireSpec::IntVar>(
1893+
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
1894+
mlir::Value cookie, mlir::Value idExpr,
1895+
const Fortran::parser::InquireSpec::IntVar &var,
1896+
Fortran::lower::StatementContext &stmtCtx) {
1897+
// IOSTAT is handled with exception conditions
1898+
if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) ==
1899+
Fortran::parser::InquireSpec::IntVar::Kind::Iostat)
1900+
return {};
1901+
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
1902+
mlir::FuncOp specFunc =
1903+
getIORuntimeFunc<mkIOKey(InquireInteger64)>(loc, builder);
1904+
mlir::FunctionType specFuncTy = specFunc.getType();
1905+
const auto *varExpr = Fortran::semantics::GetExpr(
1906+
std::get<Fortran::parser::ScalarIntVariable>(var.t));
1907+
mlir::Value addr = fir::getBase(converter.genExprAddr(varExpr, stmtCtx, loc));
1908+
mlir::Type eleTy = fir::dyn_cast_ptrEleTy(addr.getType());
1909+
if (!eleTy)
1910+
fir::emitFatalError(loc,
1911+
"internal error: expected a memory reference type");
1912+
auto bitWidth = eleTy.cast<mlir::IntegerType>().getWidth();
1913+
mlir::IndexType idxTy = builder.getIndexType();
1914+
mlir::Value kind = builder.createIntegerConstant(loc, idxTy, bitWidth / 8);
1915+
llvm::SmallVector<mlir::Value> args = {
1916+
builder.createConvert(loc, specFuncTy.getInput(0), cookie),
1917+
builder.createIntegerConstant(
1918+
loc, specFuncTy.getInput(1),
1919+
Fortran::runtime::io::HashInquiryKeyword(
1920+
Fortran::parser::InquireSpec::IntVar::EnumToString(
1921+
std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t))
1922+
.c_str())),
1923+
builder.createConvert(loc, specFuncTy.getInput(2), addr),
1924+
builder.createConvert(loc, specFuncTy.getInput(3), kind)};
1925+
return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
1926+
}
1927+
/// Specialization for LOGICAL and (PENDING + ID).
1928+
template <>
1929+
mlir::Value genInquireSpec<Fortran::parser::InquireSpec::LogVar>(
1930+
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
1931+
mlir::Value cookie, mlir::Value idExpr,
1932+
const Fortran::parser::InquireSpec::LogVar &var,
1933+
Fortran::lower::StatementContext &stmtCtx) {
1934+
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
1935+
auto logVarKind = std::get<Fortran::parser::InquireSpec::LogVar::Kind>(var.t);
1936+
bool pendId =
1937+
idExpr &&
1938+
logVarKind == Fortran::parser::InquireSpec::LogVar::Kind::Pending;
1939+
mlir::FuncOp specFunc =
1940+
pendId ? getIORuntimeFunc<mkIOKey(InquirePendingId)>(loc, builder)
1941+
: getIORuntimeFunc<mkIOKey(InquireLogical)>(loc, builder);
1942+
mlir::FunctionType specFuncTy = specFunc.getType();
1943+
mlir::Value addr = fir::getBase(converter.genExprAddr(
1944+
Fortran::semantics::GetExpr(
1945+
std::get<Fortran::parser::Scalar<
1946+
Fortran::parser::Logical<Fortran::parser::Variable>>>(var.t)),
1947+
stmtCtx, loc));
1948+
llvm::SmallVector<mlir::Value> args = {
1949+
builder.createConvert(loc, specFuncTy.getInput(0), cookie)};
1950+
if (pendId)
1951+
args.push_back(builder.createConvert(loc, specFuncTy.getInput(1), idExpr));
1952+
else
1953+
args.push_back(builder.createIntegerConstant(
1954+
loc, specFuncTy.getInput(1),
1955+
Fortran::runtime::io::HashInquiryKeyword(
1956+
Fortran::parser::InquireSpec::LogVar::EnumToString(logVarKind)
1957+
.c_str())));
1958+
args.push_back(builder.createConvert(loc, specFuncTy.getInput(2), addr));
1959+
return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
1960+
}
1961+
1962+
/// If there is an IdExpr in the list of inquire-specs, then lower it and return
1963+
/// the resulting Value. Otherwise, return null.
1964+
static mlir::Value
1965+
lowerIdExpr(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
1966+
const std::list<Fortran::parser::InquireSpec> &ispecs,
1967+
Fortran::lower::StatementContext &stmtCtx) {
1968+
for (const Fortran::parser::InquireSpec &spec : ispecs)
1969+
if (mlir::Value v = std::visit(
1970+
Fortran::common::visitors{
1971+
[&](const Fortran::parser::IdExpr &idExpr) {
1972+
return fir::getBase(converter.genExprValue(
1973+
Fortran::semantics::GetExpr(idExpr), stmtCtx, loc));
1974+
},
1975+
[](const auto &) { return mlir::Value{}; }},
1976+
spec.u))
1977+
return v;
1978+
return {};
1979+
}
1980+
1981+
/// For each inquire-spec, build the appropriate call, threading the cookie.
1982+
static void threadInquire(Fortran::lower::AbstractConverter &converter,
1983+
mlir::Location loc, mlir::Value cookie,
1984+
const std::list<Fortran::parser::InquireSpec> &ispecs,
1985+
bool checkResult, mlir::Value &ok,
1986+
Fortran::lower::StatementContext &stmtCtx) {
1987+
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
1988+
mlir::Value idExpr = lowerIdExpr(converter, loc, ispecs, stmtCtx);
1989+
for (const Fortran::parser::InquireSpec &spec : ispecs) {
1990+
makeNextConditionalOn(builder, loc, checkResult, ok);
1991+
ok = std::visit(Fortran::common::visitors{[&](const auto &x) {
1992+
return genInquireSpec(converter, loc, cookie, idExpr, x,
1993+
stmtCtx);
1994+
}},
1995+
spec.u);
1996+
}
1997+
}
1998+
1999+
mlir::Value Fortran::lower::genInquireStatement(
2000+
Fortran::lower::AbstractConverter &converter,
2001+
const Fortran::parser::InquireStmt &stmt) {
2002+
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
2003+
Fortran::lower::StatementContext stmtCtx;
2004+
mlir::Location loc = converter.getCurrentLocation();
2005+
mlir::FuncOp beginFunc;
2006+
ConditionSpecInfo csi;
2007+
llvm::SmallVector<mlir::Value> beginArgs;
2008+
const auto *list =
2009+
std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u);
2010+
auto exprPair = getInquireFileExpr(list);
2011+
auto inquireFileUnit = [&]() -> bool {
2012+
return exprPair.first && !exprPair.second;
2013+
};
2014+
auto inquireFileName = [&]() -> bool {
2015+
return exprPair.first && exprPair.second;
2016+
};
2017+
2018+
// Make one of three BeginInquire calls.
2019+
if (inquireFileUnit()) {
2020+
// Inquire by unit -- [UNIT=]file-unit-number.
2021+
beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireUnit)>(loc, builder);
2022+
mlir::FunctionType beginFuncTy = beginFunc.getType();
2023+
beginArgs = {builder.createConvert(loc, beginFuncTy.getInput(0),
2024+
fir::getBase(converter.genExprValue(
2025+
exprPair.first, stmtCtx, loc))),
2026+
locToFilename(converter, loc, beginFuncTy.getInput(1)),
2027+
locToLineNo(converter, loc, beginFuncTy.getInput(2))};
2028+
} else if (inquireFileName()) {
2029+
// Inquire by file -- FILE=file-name-expr.
2030+
beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireFile)>(loc, builder);
2031+
mlir::FunctionType beginFuncTy = beginFunc.getType();
2032+
fir::ExtendedValue file =
2033+
converter.genExprAddr(exprPair.first, stmtCtx, loc);
2034+
beginArgs = {
2035+
builder.createConvert(loc, beginFuncTy.getInput(0), fir::getBase(file)),
2036+
builder.createConvert(loc, beginFuncTy.getInput(1), fir::getLen(file)),
2037+
locToFilename(converter, loc, beginFuncTy.getInput(2)),
2038+
locToLineNo(converter, loc, beginFuncTy.getInput(3))};
2039+
} else {
2040+
// Inquire by output list -- IOLENGTH=scalar-int-variable.
2041+
const auto *ioLength =
2042+
std::get_if<Fortran::parser::InquireStmt::Iolength>(&stmt.u);
2043+
assert(ioLength && "must have an IOLENGTH specifier");
2044+
beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireIoLength)>(loc, builder);
2045+
mlir::FunctionType beginFuncTy = beginFunc.getType();
2046+
beginArgs = {locToFilename(converter, loc, beginFuncTy.getInput(0)),
2047+
locToLineNo(converter, loc, beginFuncTy.getInput(1))};
2048+
auto cookie =
2049+
builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
2050+
mlir::Value ok;
2051+
genOutputItemList(
2052+
converter, cookie,
2053+
std::get<std::list<Fortran::parser::OutputItem>>(ioLength->t),
2054+
/*isFormatted=*/false, /*checkResult=*/false, ok, /*inLoop=*/false,
2055+
stmtCtx);
2056+
auto *ioLengthVar = Fortran::semantics::GetExpr(
2057+
std::get<Fortran::parser::ScalarIntVariable>(ioLength->t));
2058+
mlir::Value ioLengthVarAddr =
2059+
fir::getBase(converter.genExprAddr(ioLengthVar, stmtCtx, loc));
2060+
llvm::SmallVector<mlir::Value> args = {cookie};
2061+
mlir::Value length =
2062+
builder
2063+
.create<fir::CallOp>(
2064+
loc, getIORuntimeFunc<mkIOKey(GetIoLength)>(loc, builder), args)
2065+
.getResult(0);
2066+
mlir::Value length1 =
2067+
builder.createConvert(loc, converter.genType(*ioLengthVar), length);
2068+
builder.create<fir::StoreOp>(loc, length1, ioLengthVarAddr);
2069+
return genEndIO(converter, loc, cookie, csi, stmtCtx);
2070+
}
2071+
2072+
// Common handling for inquire by unit or file.
2073+
assert(list && "inquire-spec list must be present");
2074+
auto cookie =
2075+
builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
2076+
genConditionHandlerCall(converter, loc, cookie, *list, csi);
2077+
// Handle remaining arguments in specifier list.
2078+
mlir::Value ok;
2079+
auto insertPt = builder.saveInsertionPoint();
2080+
threadInquire(converter, loc, cookie, *list, csi.hasErrorConditionSpec(), ok,
2081+
stmtCtx);
2082+
builder.restoreInsertionPoint(insertPt);
2083+
// Generate end statement call.
2084+
return genEndIO(converter, loc, cookie, csi, stmtCtx);
2085+
}

‎flang/lib/Optimizer/Builder/Character.cpp

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,11 @@ fir::factory::CharacterExprHelper::getCharacterType(mlir::Type type) {
4343
return recoverCharacterType(type);
4444
}
4545

46+
fir::CharacterType
47+
fir::factory::CharacterExprHelper::getCharType(mlir::Type type) {
48+
return recoverCharacterType(type);
49+
}
50+
4651
fir::CharacterType fir::factory::CharacterExprHelper::getCharacterType(
4752
const fir::CharBoxValue &box) {
4853
return getCharacterType(box.getBuffer().getType());

‎flang/test/Lower/io-statement-1.f90

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,8 +52,47 @@
5252
! CHECK: call {{.*}}OutputAscii
5353
! CHECK: call {{.*}}EndIoStatement
5454
print *, "A literal string"
55+
56+
! CHECK: call {{.*}}BeginInquireUnit
57+
! CHECK: call {{.*}}EndIoStatement
58+
inquire(4, EXIST=existsvar)
59+
60+
! CHECK: call {{.*}}BeginInquireFile
61+
! CHECK: call {{.*}}EndIoStatement
62+
inquire(FILE="fail.f90", EXIST=existsvar)
63+
64+
! CHECK: call {{.*}}BeginInquireIoLength
65+
! CHECK-COUNT-3: call {{.*}}OutputDescriptor
66+
! CHECK: call {{.*}}EndIoStatement
67+
inquire (iolength=length) existsvar, length, a
5568
end
5669

70+
! Tests the 3 basic inquire formats
71+
! CHECK-LABEL: func @_QPinquire_test
72+
subroutine inquire_test(ch, i, b)
73+
character(80) :: ch
74+
integer :: i
75+
logical :: b
76+
77+
! CHARACTER
78+
! CHECK: %[[sugar:.*]] = fir.call {{.*}}BeginInquireUnit
79+
! CHECK: call {{.*}}InquireCharacter(%[[sugar]], %c{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64) -> i1
80+
! CHECK: call {{.*}}EndIoStatement
81+
inquire(88, name=ch)
82+
83+
! INTEGER
84+
! CHECK: %[[oatmeal:.*]] = fir.call {{.*}}BeginInquireUnit
85+
! CHECK: call @_FortranAioInquireInteger64(%[[oatmeal]], %c{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64, !fir.ref<i64>, i32) -> i1
86+
! CHECK: call {{.*}}EndIoStatement
87+
inquire(89, pos=i)
88+
89+
! LOGICAL
90+
! CHECK: %[[snicker:.*]] = fir.call {{.*}}BeginInquireUnit
91+
! CHECK: call @_FortranAioInquireLogical(%[[snicker]], %c{{.*}}, %[[b:.*]]) : (!fir.ref<i8>, i64, !fir.ref<i1>) -> i1
92+
! CHECK: call {{.*}}EndIoStatement
93+
inquire(90, opened=b)
94+
end subroutine inquire_test
95+
5796
! CHECK-LABEL: @_QPboz
5897
subroutine boz
5998
! CHECK: fir.call @_FortranAioOutputInteger8(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i8) -> i1

0 commit comments

Comments
 (0)