@@ -1829,3 +1829,257 @@ Fortran::lower::genReadStatement(Fortran::lower::AbstractConverter &converter,
1829
1829
const Fortran::parser::ReadStmt &stmt) {
1830
1830
return genDataTransferStmt</* isInput=*/ true >(converter, stmt);
1831
1831
}
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
+ }
0 commit comments