[flang-commits] [flang] 7e32cad - [flang] Lower inquire statement
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Wed Mar 2 09:03:38 PST 2022
Author: Valentin Clement
Date: 2022-03-02T18:03:29+01:00
New Revision: 7e32cada0105ec8756ce09a9fc07e2b10803d620
URL: https://github.com/llvm/llvm-project/commit/7e32cada0105ec8756ce09a9fc07e2b10803d620
DIFF: https://github.com/llvm/llvm-project/commit/7e32cada0105ec8756ce09a9fc07e2b10803d620.diff
LOG: [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 <jperier at nvidia.com>
Added:
Modified:
flang/include/flang/Lower/IO.h
flang/include/flang/Optimizer/Builder/Character.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/IO.cpp
flang/lib/Optimizer/Builder/Character.cpp
flang/test/Lower/io-statement-1.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/IO.h b/flang/include/flang/Lower/IO.h
index d7cb1a8b775e7..a9b0b0b0b7908 100644
--- a/flang/include/flang/Lower/IO.h
+++ b/flang/include/flang/Lower/IO.h
@@ -23,6 +23,7 @@ struct BackspaceStmt;
struct CloseStmt;
struct EndfileStmt;
struct FlushStmt;
+struct InquireStmt;
struct OpenStmt;
struct ReadStmt;
struct RewindStmt;
@@ -49,6 +50,10 @@ mlir::Value genEndfileStatement(AbstractConverter &,
/// Generate IO call(s) for FLUSH; return the IOSTAT code
mlir::Value genFlushStatement(AbstractConverter &, const parser::FlushStmt &);
+/// Generate IO call(s) for INQUIRE; return the IOSTAT code
+mlir::Value genInquireStatement(AbstractConverter &,
+ const parser::InquireStmt &);
+
/// Generate IO call(s) for READ; return the IOSTAT code
mlir::Value genReadStatement(AbstractConverter &converter,
const parser::ReadStmt &stmt);
diff --git a/flang/include/flang/Optimizer/Builder/Character.h b/flang/include/flang/Optimizer/Builder/Character.h
index f82a7926ee483..d1b5964a6b6b0 100644
--- a/flang/include/flang/Optimizer/Builder/Character.h
+++ b/flang/include/flang/Optimizer/Builder/Character.h
@@ -107,6 +107,10 @@ class CharacterExprHelper {
/// Extract the kind of a character or array of character type.
static fir::KindTy getCharacterOrSequenceKind(mlir::Type type);
+ /// Determine the inner character type. Unwraps references, boxes, and
+ /// sequences to find the !fir.char element type.
+ static fir::CharacterType getCharType(mlir::Type type);
+
/// Determine the base character type
static fir::CharacterType getCharacterType(mlir::Type type);
static fir::CharacterType getCharacterType(const fir::CharBoxValue &box);
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 33bbd5bf7590f..210d0fbadbdb9 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -831,7 +831,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
void genFIR(const Fortran::parser::InquireStmt &stmt) {
- TODO(toLocation(), "InquireStmt lowering");
+ mlir::Value iostat = genInquireStatement(*this, stmt);
+ if (const auto *specs =
+ std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u))
+ genIoConditionBranches(getEval(), *specs, iostat);
}
void genFIR(const Fortran::parser::OpenStmt &stmt) {
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 7d4a4d0f27f7f..be32d99814d60 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -2484,7 +2484,31 @@ class ArrayExprLowering {
if (destShape.empty())
destShape = getShape(arrayOperands.back());
if (isBoxValue()) {
- TODO(loc, "genarr BoxValue");
+ // Semantics are a reference to a boxed array.
+ // This case just requires that an embox operation be created to box the
+ // value. The value of the box is forwarded in the continuation.
+ mlir::Type reduceTy = reduceRank(arrTy, slice);
+ auto boxTy = fir::BoxType::get(reduceTy);
+ if (components.substring) {
+ // Adjust char length to substring size.
+ fir::CharacterType charTy =
+ fir::factory::CharacterExprHelper::getCharType(reduceTy);
+ auto seqTy = reduceTy.cast<fir::SequenceType>();
+ // TODO: Use a constant for fir.char LEN if we can compute it.
+ boxTy = fir::BoxType::get(
+ fir::SequenceType::get(fir::CharacterType::getUnknownLen(
+ builder.getContext(), charTy.getFKind()),
+ seqTy.getDimension()));
+ }
+ mlir::Value embox =
+ memref.getType().isa<fir::BoxType>()
+ ? builder.create<fir::ReboxOp>(loc, boxTy, memref, shape, slice)
+ .getResult()
+ : builder
+ .create<fir::EmboxOp>(loc, boxTy, memref, shape, slice,
+ fir::getTypeParams(extMemref))
+ .getResult();
+ return [=](IterSpace) -> ExtValue { return fir::BoxValue(embox); };
}
if (isReferentiallyOpaque()) {
TODO(loc, "genarr isReferentiallyOpaque");
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index d3f45a7480c3e..4f194f9e7496e 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -1829,3 +1829,257 @@ Fortran::lower::genReadStatement(Fortran::lower::AbstractConverter &converter,
const Fortran::parser::ReadStmt &stmt) {
return genDataTransferStmt</*isInput=*/true>(converter, stmt);
}
+
+/// Get the file expression from the inquire spec list. Also return if the
+/// expression is a file name.
+static std::pair<const Fortran::lower::SomeExpr *, bool>
+getInquireFileExpr(const std::list<Fortran::parser::InquireSpec> *stmt) {
+ if (!stmt)
+ return {nullptr, /*filename?=*/false};
+ for (const Fortran::parser::InquireSpec &spec : *stmt) {
+ if (auto *f = std::get_if<Fortran::parser::FileUnitNumber>(&spec.u))
+ return {Fortran::semantics::GetExpr(*f), /*filename?=*/false};
+ if (auto *f = std::get_if<Fortran::parser::FileNameExpr>(&spec.u))
+ return {Fortran::semantics::GetExpr(*f), /*filename?=*/true};
+ }
+ // semantics should have already caught this condition
+ llvm::report_fatal_error("inquire spec must have a file");
+}
+
+/// Generate calls to the four distinct INQUIRE subhandlers. An INQUIRE may
+/// return values of type CHARACTER, INTEGER, or LOGICAL. There is one
+/// additional special case for INQUIRE with both PENDING and ID specifiers.
+template <typename A>
+static mlir::Value genInquireSpec(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc, mlir::Value cookie,
+ mlir::Value idExpr, const A &var,
+ Fortran::lower::StatementContext &stmtCtx) {
+ // default case: do nothing
+ return {};
+}
+/// Specialization for CHARACTER.
+template <>
+mlir::Value genInquireSpec<Fortran::parser::InquireSpec::CharVar>(
+ Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+ mlir::Value cookie, mlir::Value idExpr,
+ const Fortran::parser::InquireSpec::CharVar &var,
+ Fortran::lower::StatementContext &stmtCtx) {
+ // IOMSG is handled with exception conditions
+ if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t) ==
+ Fortran::parser::InquireSpec::CharVar::Kind::Iomsg)
+ return {};
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::FuncOp specFunc =
+ getIORuntimeFunc<mkIOKey(InquireCharacter)>(loc, builder);
+ mlir::FunctionType specFuncTy = specFunc.getType();
+ const auto *varExpr = Fortran::semantics::GetExpr(
+ std::get<Fortran::parser::ScalarDefaultCharVariable>(var.t));
+ fir::ExtendedValue str = converter.genExprAddr(varExpr, stmtCtx, loc);
+ llvm::SmallVector<mlir::Value> args = {
+ builder.createConvert(loc, specFuncTy.getInput(0), cookie),
+ builder.createIntegerConstant(
+ loc, specFuncTy.getInput(1),
+ Fortran::runtime::io::HashInquiryKeyword(
+ Fortran::parser::InquireSpec::CharVar::EnumToString(
+ std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t))
+ .c_str())),
+ builder.createConvert(loc, specFuncTy.getInput(2), fir::getBase(str)),
+ builder.createConvert(loc, specFuncTy.getInput(3), fir::getLen(str))};
+ return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
+}
+/// Specialization for INTEGER.
+template <>
+mlir::Value genInquireSpec<Fortran::parser::InquireSpec::IntVar>(
+ Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+ mlir::Value cookie, mlir::Value idExpr,
+ const Fortran::parser::InquireSpec::IntVar &var,
+ Fortran::lower::StatementContext &stmtCtx) {
+ // IOSTAT is handled with exception conditions
+ if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) ==
+ Fortran::parser::InquireSpec::IntVar::Kind::Iostat)
+ return {};
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::FuncOp specFunc =
+ getIORuntimeFunc<mkIOKey(InquireInteger64)>(loc, builder);
+ mlir::FunctionType specFuncTy = specFunc.getType();
+ const auto *varExpr = Fortran::semantics::GetExpr(
+ std::get<Fortran::parser::ScalarIntVariable>(var.t));
+ mlir::Value addr = fir::getBase(converter.genExprAddr(varExpr, stmtCtx, loc));
+ mlir::Type eleTy = fir::dyn_cast_ptrEleTy(addr.getType());
+ if (!eleTy)
+ fir::emitFatalError(loc,
+ "internal error: expected a memory reference type");
+ auto bitWidth = eleTy.cast<mlir::IntegerType>().getWidth();
+ mlir::IndexType idxTy = builder.getIndexType();
+ mlir::Value kind = builder.createIntegerConstant(loc, idxTy, bitWidth / 8);
+ llvm::SmallVector<mlir::Value> args = {
+ builder.createConvert(loc, specFuncTy.getInput(0), cookie),
+ builder.createIntegerConstant(
+ loc, specFuncTy.getInput(1),
+ Fortran::runtime::io::HashInquiryKeyword(
+ Fortran::parser::InquireSpec::IntVar::EnumToString(
+ std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t))
+ .c_str())),
+ builder.createConvert(loc, specFuncTy.getInput(2), addr),
+ builder.createConvert(loc, specFuncTy.getInput(3), kind)};
+ return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
+}
+/// Specialization for LOGICAL and (PENDING + ID).
+template <>
+mlir::Value genInquireSpec<Fortran::parser::InquireSpec::LogVar>(
+ Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+ mlir::Value cookie, mlir::Value idExpr,
+ const Fortran::parser::InquireSpec::LogVar &var,
+ Fortran::lower::StatementContext &stmtCtx) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ auto logVarKind = std::get<Fortran::parser::InquireSpec::LogVar::Kind>(var.t);
+ bool pendId =
+ idExpr &&
+ logVarKind == Fortran::parser::InquireSpec::LogVar::Kind::Pending;
+ mlir::FuncOp specFunc =
+ pendId ? getIORuntimeFunc<mkIOKey(InquirePendingId)>(loc, builder)
+ : getIORuntimeFunc<mkIOKey(InquireLogical)>(loc, builder);
+ mlir::FunctionType specFuncTy = specFunc.getType();
+ mlir::Value addr = fir::getBase(converter.genExprAddr(
+ Fortran::semantics::GetExpr(
+ std::get<Fortran::parser::Scalar<
+ Fortran::parser::Logical<Fortran::parser::Variable>>>(var.t)),
+ stmtCtx, loc));
+ llvm::SmallVector<mlir::Value> args = {
+ builder.createConvert(loc, specFuncTy.getInput(0), cookie)};
+ if (pendId)
+ args.push_back(builder.createConvert(loc, specFuncTy.getInput(1), idExpr));
+ else
+ args.push_back(builder.createIntegerConstant(
+ loc, specFuncTy.getInput(1),
+ Fortran::runtime::io::HashInquiryKeyword(
+ Fortran::parser::InquireSpec::LogVar::EnumToString(logVarKind)
+ .c_str())));
+ args.push_back(builder.createConvert(loc, specFuncTy.getInput(2), addr));
+ return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
+}
+
+/// If there is an IdExpr in the list of inquire-specs, then lower it and return
+/// the resulting Value. Otherwise, return null.
+static mlir::Value
+lowerIdExpr(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+ const std::list<Fortran::parser::InquireSpec> &ispecs,
+ Fortran::lower::StatementContext &stmtCtx) {
+ for (const Fortran::parser::InquireSpec &spec : ispecs)
+ if (mlir::Value v = std::visit(
+ Fortran::common::visitors{
+ [&](const Fortran::parser::IdExpr &idExpr) {
+ return fir::getBase(converter.genExprValue(
+ Fortran::semantics::GetExpr(idExpr), stmtCtx, loc));
+ },
+ [](const auto &) { return mlir::Value{}; }},
+ spec.u))
+ return v;
+ return {};
+}
+
+/// For each inquire-spec, build the appropriate call, threading the cookie.
+static void threadInquire(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc, mlir::Value cookie,
+ const std::list<Fortran::parser::InquireSpec> &ispecs,
+ bool checkResult, mlir::Value &ok,
+ Fortran::lower::StatementContext &stmtCtx) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::Value idExpr = lowerIdExpr(converter, loc, ispecs, stmtCtx);
+ for (const Fortran::parser::InquireSpec &spec : ispecs) {
+ makeNextConditionalOn(builder, loc, checkResult, ok);
+ ok = std::visit(Fortran::common::visitors{[&](const auto &x) {
+ return genInquireSpec(converter, loc, cookie, idExpr, x,
+ stmtCtx);
+ }},
+ spec.u);
+ }
+}
+
+mlir::Value Fortran::lower::genInquireStatement(
+ Fortran::lower::AbstractConverter &converter,
+ const Fortran::parser::InquireStmt &stmt) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ Fortran::lower::StatementContext stmtCtx;
+ mlir::Location loc = converter.getCurrentLocation();
+ mlir::FuncOp beginFunc;
+ ConditionSpecInfo csi;
+ llvm::SmallVector<mlir::Value> beginArgs;
+ const auto *list =
+ std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u);
+ auto exprPair = getInquireFileExpr(list);
+ auto inquireFileUnit = [&]() -> bool {
+ return exprPair.first && !exprPair.second;
+ };
+ auto inquireFileName = [&]() -> bool {
+ return exprPair.first && exprPair.second;
+ };
+
+ // Make one of three BeginInquire calls.
+ if (inquireFileUnit()) {
+ // Inquire by unit -- [UNIT=]file-unit-number.
+ beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireUnit)>(loc, builder);
+ mlir::FunctionType beginFuncTy = beginFunc.getType();
+ beginArgs = {builder.createConvert(loc, beginFuncTy.getInput(0),
+ fir::getBase(converter.genExprValue(
+ exprPair.first, stmtCtx, loc))),
+ locToFilename(converter, loc, beginFuncTy.getInput(1)),
+ locToLineNo(converter, loc, beginFuncTy.getInput(2))};
+ } else if (inquireFileName()) {
+ // Inquire by file -- FILE=file-name-expr.
+ beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireFile)>(loc, builder);
+ mlir::FunctionType beginFuncTy = beginFunc.getType();
+ fir::ExtendedValue file =
+ converter.genExprAddr(exprPair.first, stmtCtx, loc);
+ beginArgs = {
+ builder.createConvert(loc, beginFuncTy.getInput(0), fir::getBase(file)),
+ builder.createConvert(loc, beginFuncTy.getInput(1), fir::getLen(file)),
+ locToFilename(converter, loc, beginFuncTy.getInput(2)),
+ locToLineNo(converter, loc, beginFuncTy.getInput(3))};
+ } else {
+ // Inquire by output list -- IOLENGTH=scalar-int-variable.
+ const auto *ioLength =
+ std::get_if<Fortran::parser::InquireStmt::Iolength>(&stmt.u);
+ assert(ioLength && "must have an IOLENGTH specifier");
+ beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireIoLength)>(loc, builder);
+ mlir::FunctionType beginFuncTy = beginFunc.getType();
+ beginArgs = {locToFilename(converter, loc, beginFuncTy.getInput(0)),
+ locToLineNo(converter, loc, beginFuncTy.getInput(1))};
+ auto cookie =
+ builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
+ mlir::Value ok;
+ genOutputItemList(
+ converter, cookie,
+ std::get<std::list<Fortran::parser::OutputItem>>(ioLength->t),
+ /*isFormatted=*/false, /*checkResult=*/false, ok, /*inLoop=*/false,
+ stmtCtx);
+ auto *ioLengthVar = Fortran::semantics::GetExpr(
+ std::get<Fortran::parser::ScalarIntVariable>(ioLength->t));
+ mlir::Value ioLengthVarAddr =
+ fir::getBase(converter.genExprAddr(ioLengthVar, stmtCtx, loc));
+ llvm::SmallVector<mlir::Value> args = {cookie};
+ mlir::Value length =
+ builder
+ .create<fir::CallOp>(
+ loc, getIORuntimeFunc<mkIOKey(GetIoLength)>(loc, builder), args)
+ .getResult(0);
+ mlir::Value length1 =
+ builder.createConvert(loc, converter.genType(*ioLengthVar), length);
+ builder.create<fir::StoreOp>(loc, length1, ioLengthVarAddr);
+ return genEndIO(converter, loc, cookie, csi, stmtCtx);
+ }
+
+ // Common handling for inquire by unit or file.
+ assert(list && "inquire-spec list must be present");
+ auto cookie =
+ builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
+ genConditionHandlerCall(converter, loc, cookie, *list, csi);
+ // Handle remaining arguments in specifier list.
+ mlir::Value ok;
+ auto insertPt = builder.saveInsertionPoint();
+ threadInquire(converter, loc, cookie, *list, csi.hasErrorConditionSpec(), ok,
+ stmtCtx);
+ builder.restoreInsertionPoint(insertPt);
+ // Generate end statement call.
+ return genEndIO(converter, loc, cookie, csi, stmtCtx);
+}
diff --git a/flang/lib/Optimizer/Builder/Character.cpp b/flang/lib/Optimizer/Builder/Character.cpp
index b10535635a13d..4a1226eec0aba 100644
--- a/flang/lib/Optimizer/Builder/Character.cpp
+++ b/flang/lib/Optimizer/Builder/Character.cpp
@@ -43,6 +43,11 @@ fir::factory::CharacterExprHelper::getCharacterType(mlir::Type type) {
return recoverCharacterType(type);
}
+fir::CharacterType
+fir::factory::CharacterExprHelper::getCharType(mlir::Type type) {
+ return recoverCharacterType(type);
+}
+
fir::CharacterType fir::factory::CharacterExprHelper::getCharacterType(
const fir::CharBoxValue &box) {
return getCharacterType(box.getBuffer().getType());
diff --git a/flang/test/Lower/io-statement-1.f90 b/flang/test/Lower/io-statement-1.f90
index edf6f77aeeeeb..c263a1138051b 100644
--- a/flang/test/Lower/io-statement-1.f90
+++ b/flang/test/Lower/io-statement-1.f90
@@ -52,8 +52,47 @@
! CHECK: call {{.*}}OutputAscii
! CHECK: call {{.*}}EndIoStatement
print *, "A literal string"
+
+ ! CHECK: call {{.*}}BeginInquireUnit
+ ! CHECK: call {{.*}}EndIoStatement
+ inquire(4, EXIST=existsvar)
+
+ ! CHECK: call {{.*}}BeginInquireFile
+ ! CHECK: call {{.*}}EndIoStatement
+ inquire(FILE="fail.f90", EXIST=existsvar)
+
+ ! CHECK: call {{.*}}BeginInquireIoLength
+ ! CHECK-COUNT-3: call {{.*}}OutputDescriptor
+ ! CHECK: call {{.*}}EndIoStatement
+ inquire (iolength=length) existsvar, length, a
end
+! Tests the 3 basic inquire formats
+! CHECK-LABEL: func @_QPinquire_test
+subroutine inquire_test(ch, i, b)
+ character(80) :: ch
+ integer :: i
+ logical :: b
+
+ ! CHARACTER
+ ! CHECK: %[[sugar:.*]] = fir.call {{.*}}BeginInquireUnit
+ ! CHECK: call {{.*}}InquireCharacter(%[[sugar]], %c{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64) -> i1
+ ! CHECK: call {{.*}}EndIoStatement
+ inquire(88, name=ch)
+
+ ! INTEGER
+ ! CHECK: %[[oatmeal:.*]] = fir.call {{.*}}BeginInquireUnit
+ ! CHECK: call @_FortranAioInquireInteger64(%[[oatmeal]], %c{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64, !fir.ref<i64>, i32) -> i1
+ ! CHECK: call {{.*}}EndIoStatement
+ inquire(89, pos=i)
+
+ ! LOGICAL
+ ! CHECK: %[[snicker:.*]] = fir.call {{.*}}BeginInquireUnit
+ ! CHECK: call @_FortranAioInquireLogical(%[[snicker]], %c{{.*}}, %[[b:.*]]) : (!fir.ref<i8>, i64, !fir.ref<i1>) -> i1
+ ! CHECK: call {{.*}}EndIoStatement
+ inquire(90, opened=b)
+end subroutine inquire_test
+
! CHECK-LABEL: @_QPboz
subroutine boz
! CHECK: fir.call @_FortranAioOutputInteger8(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i8) -> i1
More information about the flang-commits
mailing list