diff --git a/flang/include/flang/Runtime/io-api.h b/flang/include/flang/Runtime/io-api.h index 0277f0ea9e97e..556cc20c5a121 100644 --- a/flang/include/flang/Runtime/io-api.h +++ b/flang/include/flang/Runtime/io-api.h @@ -332,7 +332,7 @@ std::size_t IONAME(GetIoLength)(Cookie); void IONAME(GetIoMsg)(Cookie, char *, std::size_t); // IOMSG= // Defines ID= on READ/WRITE(ASYNCHRONOUS='YES') -int IONAME(GetAsynchronousId)(Cookie); +AsynchronousId IONAME(GetAsynchronousId)(Cookie); // INQUIRE() specifiers are mostly identified by their NUL-terminated // case-insensitive names. @@ -343,7 +343,7 @@ bool IONAME(InquireCharacter)(Cookie, InquiryKeywordHash, char *, std::size_t); // EXIST, NAMED, OPENED, and PENDING (without ID): bool IONAME(InquireLogical)(Cookie, InquiryKeywordHash, bool &); // PENDING with ID -bool IONAME(InquirePendingId)(Cookie, std::int64_t, bool &); +bool IONAME(InquirePendingId)(Cookie, AsynchronousId, bool &); // NEXTREC, NUMBER, POS, RECL, SIZE bool IONAME(InquireInteger64)( Cookie, InquiryKeywordHash, std::int64_t &, int kind = 8); diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 46e5639918b25..fa5406325ca96 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -976,8 +976,11 @@ class Fortran::lower::CallInterfaceImpl { }; if (obj.attrs.test(Attrs::Optional)) addMLIRAttr(fir::getOptionalAttrName()); - if (obj.attrs.test(Attrs::Asynchronous)) - TODO(loc, "ASYNCHRONOUS in procedure interface"); + // Skipping obj.attrs.test(Attrs::Asynchronous), this does not impact the + // way the argument is passed given flang implement asynch IO synchronously. + // TODO: it would be safer to treat them as volatile because since Fortran + // 2018 asynchronous can also be used for C defined asynchronous user + // processes (see 18.10.4 Asynchronous communication). if (obj.attrs.test(Attrs::Contiguous)) addMLIRAttr(fir::getContiguousAttrName()); if (obj.attrs.test(Attrs::Value)) diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index 3933ebeb9b3cc..699897adcd0b2 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -96,12 +96,13 @@ static constexpr std::tuple< mkIOKey(BeginUnformattedInput), mkIOKey(BeginUnformattedOutput), mkIOKey(BeginWait), mkIOKey(BeginWaitAll), mkIOKey(CheckUnitNumberInRange64), mkIOKey(CheckUnitNumberInRange128), - mkIOKey(EnableHandlers), mkIOKey(EndIoStatement), mkIOKey(GetIoLength), - mkIOKey(GetIoMsg), mkIOKey(GetNewUnit), mkIOKey(GetSize), - mkIOKey(InputAscii), mkIOKey(InputComplex32), mkIOKey(InputComplex64), - mkIOKey(InputDerivedType), mkIOKey(InputDescriptor), mkIOKey(InputInteger), - mkIOKey(InputLogical), mkIOKey(InputNamelist), mkIOKey(InputReal32), - mkIOKey(InputReal64), mkIOKey(InquireCharacter), mkIOKey(InquireInteger64), + mkIOKey(EnableHandlers), mkIOKey(EndIoStatement), + mkIOKey(GetAsynchronousId), mkIOKey(GetIoLength), mkIOKey(GetIoMsg), + mkIOKey(GetNewUnit), mkIOKey(GetSize), mkIOKey(InputAscii), + mkIOKey(InputComplex32), mkIOKey(InputComplex64), mkIOKey(InputDerivedType), + mkIOKey(InputDescriptor), mkIOKey(InputInteger), mkIOKey(InputLogical), + mkIOKey(InputNamelist), mkIOKey(InputReal32), mkIOKey(InputReal64), + mkIOKey(InquireCharacter), mkIOKey(InquireInteger64), mkIOKey(InquireLogical), mkIOKey(InquirePendingId), mkIOKey(OutputAscii), mkIOKey(OutputComplex32), mkIOKey(OutputComplex64), mkIOKey(OutputDerivedType), mkIOKey(OutputDescriptor), @@ -1313,13 +1314,6 @@ mlir::Value genIOOption( spec.v); } -template <> -mlir::Value genIOOption( - Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::IdVariable &spec) { - TODO(loc, "asynchronous ID not implemented"); -} - template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, @@ -1334,35 +1328,21 @@ mlir::Value genIOOption( return genIntIOOption(converter, loc, cookie, spec); } -/// Generate runtime call to query the read size after an input statement if -/// the statement has SIZE control-spec. -template -static void genIOReadSize(Fortran::lower::AbstractConverter &converter, - mlir::Location loc, mlir::Value cookie, - const A &specList, bool checkResult) { - // This call is not conditional on the current IO status (ok) because the size - // needs to be filled even if some error condition (end-of-file...) was met - // during the input statement (in which case the runtime may return zero for - // the size read). - for (const auto &spec : specList) - if (const auto *size = - std::get_if(&spec.u)) { - - fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - mlir::func::FuncOp ioFunc = - getIORuntimeFunc(loc, builder); - auto sizeValue = - builder.create(loc, ioFunc, mlir::ValueRange{cookie}) - .getResult(0); - Fortran::lower::StatementContext localStatementCtx; - fir::ExtendedValue var = converter.genExprAddr( - loc, Fortran::semantics::GetExpr(size->v), localStatementCtx); - mlir::Value varAddr = fir::getBase(var); - mlir::Type varType = fir::unwrapPassByRefType(varAddr.getType()); - mlir::Value sizeCast = builder.createConvert(loc, varType, sizeValue); - builder.create(loc, sizeCast, varAddr); - break; - } +/// Generate runtime call to set some control variable. +/// Generates "VAR = IoRuntimeKey(cookie)". +template +static void genIOGetVar(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Value cookie, + const VAR &parserVar) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::func::FuncOp ioFunc = getIORuntimeFunc(loc, builder); + mlir::Value value = + builder.create(loc, ioFunc, mlir::ValueRange{cookie}) + .getResult(0); + Fortran::lower::StatementContext localStatementCtx; + fir::ExtendedValue var = converter.genExprAddr( + loc, Fortran::semantics::GetExpr(parserVar.v), localStatementCtx); + builder.createStoreWithConvert(loc, value, fir::getBase(var)); } //===----------------------------------------------------------------------===// @@ -1412,6 +1392,12 @@ static void threadSpecs(Fortran::lower::AbstractConverter &converter, // there is an error. return ok; }, + [&](const Fortran::parser::IdVariable &) -> mlir::Value { + // ID is queried after the transfer so that ASYNCHROUNOUS= has + // been processed and also to set it to zero if the transfer is + // already finished. + return ok; + }, [&](const auto &x) { return genIOOption(converter, loc, cookie, x); }}, @@ -1602,21 +1588,6 @@ maybeGetInternalIODescriptor( return std::nullopt; } -template -static bool isDataTransferAsynchronous(mlir::Location loc, const A &stmt) { - if (auto *asynch = - getIOControl(stmt)) { - // FIXME: should contain a string of YES or NO - TODO(loc, "asynchronous transfers not implemented in runtime"); - } - return false; -} -template <> -bool isDataTransferAsynchronous( - mlir::Location, const Fortran::parser::PrintStmt &) { - return false; -} - template static bool isDataTransferNamelist(const A &stmt) { if (stmt.format) @@ -2043,7 +2014,7 @@ template mlir::func::FuncOp getBeginDataTransferFunc(mlir::Location loc, fir::FirOpBuilder &builder, bool isFormatted, bool isListOrNml, bool isInternal, - bool isInternalWithDesc, bool isAsync) { + bool isInternalWithDesc) { if constexpr (isInput) { if (isFormatted || isListOrNml) { if (isInternal) { @@ -2098,7 +2069,6 @@ void genBeginDataTransferCallArgs( Fortran::lower::AbstractConverter &converter, mlir::Location loc, const A &stmt, mlir::FunctionType ioFuncTy, bool isFormatted, bool isListOrNml, [[maybe_unused]] bool isInternal, - [[maybe_unused]] bool isAsync, const std::optional &descRef, ConditionSpecInfo &csi, Fortran::lower::StatementContext &stmtCtx) { fir::FirOpBuilder &builder = converter.getFirOpBuilder(); @@ -2146,8 +2116,6 @@ void genBeginDataTransferCallArgs( ioArgs.push_back( // buffer length getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size()))); } else { // external IO - maybe explicit format; unit - if (isAsync) - TODO(loc, "asynchronous"); maybeGetFormatArgs(); ioArgs.push_back(getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), csi, stmtCtx, @@ -2180,8 +2148,12 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter, isInternal ? maybeGetInternalIODescriptor(converter, loc, stmt, stmtCtx) : std::nullopt; const bool isInternalWithDesc = descRef.has_value(); - const bool isAsync = isDataTransferAsynchronous(loc, stmt); const bool isNml = isDataTransferNamelist(stmt); + // Flang runtime currently implement asynchronous IO synchronously, so + // asynchronous IO statements are lowered as regular IO statements + // (except that GetAsynchronousId may be called to set the ID variable + // and SetAsynchronous will be call to tell the runtime that this is supposed + // to be (or not) an asynchronous IO statements). // Generate an EnableHandlers call and remaining specifier calls. ConditionSpecInfo csi; @@ -2192,13 +2164,13 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter, // Generate the begin data transfer function call. mlir::func::FuncOp ioFunc = getBeginDataTransferFunc( loc, builder, isFormatted, isList || isNml, isInternal, - isInternalWithDesc, isAsync); + isInternalWithDesc); llvm::SmallVector ioArgs; genBeginDataTransferCallArgs< hasIOCtrl, isInput ? Fortran::runtime::io::DefaultInputUnit : Fortran::runtime::io::DefaultOutputUnit>( ioArgs, converter, loc, stmt, ioFunc.getFunctionType(), isFormatted, - isList || isNml, isInternal, isAsync, descRef, csi, stmtCtx); + isList || isNml, isInternal, descRef, csi, stmtCtx); mlir::Value cookie = builder.create(loc, ioFunc, ioArgs).getResult(0); @@ -2238,8 +2210,18 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter, builder.restoreInsertionPoint(insertPt); if constexpr (hasIOCtrl) { - genIOReadSize(converter, loc, cookie, stmt.controls, - csi.hasErrorConditionSpec()); + for (const auto &spec : stmt.controls) + if (const auto *size = + std::get_if(&spec.u)) { + // This call is not conditional on the current IO status (ok) because + // the size needs to be filled even if some error condition + // (end-of-file...) was met during the input statement (in which case + // the runtime may return zero for the size read). + genIOGetVar(converter, loc, cookie, *size); + } else if (const auto *idVar = + std::get_if(&spec.u)) { + genIOGetVar(converter, loc, cookie, *idVar); + } } // Generate end statement call/s. mlir::Value result = genEndIO(converter, loc, cookie, csi, stmtCtx); diff --git a/flang/runtime/io-api.cpp b/flang/runtime/io-api.cpp index 79d43c7cc884f..0ac20d3346dd5 100644 --- a/flang/runtime/io-api.cpp +++ b/flang/runtime/io-api.cpp @@ -1401,6 +1401,19 @@ void IONAME(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) { } } +AsynchronousId IONAME(GetAsynchronousId)(Cookie cookie) { + IoStatementState &io{*cookie}; + IoErrorHandler &handler{io.GetIoErrorHandler()}; + if (auto *ext{io.get_if()}) { + return ext->asynchronousID(); + } else if (!io.get_if() && + !io.get_if()) { + handler.Crash( + "GetAsynchronousId() called when not in an external I/O statement"); + } + return 0; +} + bool IONAME(InquireCharacter)(Cookie cookie, InquiryKeywordHash inquiry, char *result, std::size_t length) { IoStatementState &io{*cookie}; @@ -1413,7 +1426,7 @@ bool IONAME(InquireLogical)( return io.Inquire(inquiry, result); } -bool IONAME(InquirePendingId)(Cookie cookie, std::int64_t id, bool &result) { +bool IONAME(InquirePendingId)(Cookie cookie, AsynchronousId id, bool &result) { IoStatementState &io{*cookie}; return io.Inquire(HashInquiryKeyword("PENDING"), id, result); } diff --git a/flang/test/Lower/io-asynchronous.f90 b/flang/test/Lower/io-asynchronous.f90 new file mode 100644 index 0000000000000..8015354d9440c --- /dev/null +++ b/flang/test/Lower/io-asynchronous.f90 @@ -0,0 +1,58 @@ +! Test lowering of ASYNCHRONOUS variables and IO statements. +! RUN: bbc -emit-hlfir -o - %s | FileCheck %s + +module test_async +contains +subroutine test(x, iounit, idvar, pending) + real, asynchronous :: x(10) + integer :: idvar, iounit + logical :: pending +! CHECK-LABEL: func.func @_QMtest_asyncPtest( +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %{{.*}}idvar +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %{{.*}}iounit +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %{{.*}}pending +! CHECK: hlfir.declare %{{.*}}fir.var_attrs{{.*}}x + + open(unit=iounit, asynchronous='yes') +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref +! CHECK: %[[VAL_14:.*]] = fir.call @_FortranAioBeginOpenUnit(%[[VAL_10]] +! CHECK: %[[VAL_20:.*]] = fir.call @_FortranAioSetAsynchronous(%[[VAL_14]] +! CHECK: %[[VAL_21:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_14]]) + + write(unit=iounit,id=idvar, asynchronous='yes', fmt=*) x +! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.call @_FortranAioBeginExternalListOutput(%[[VAL_22]], +! CHECK: %[[VAL_32:.*]] = fir.call @_FortranAioSetAsynchronous(%[[VAL_26]], +! CHECK: %[[VAL_36:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_26]], +! CHECK: %[[VAL_37:.*]] = fir.call @_FortranAioGetAsynchronousId(%[[VAL_26]]) +! CHECK: fir.store %[[VAL_37]] to %[[VAL_4]]#1 : !fir.ref +! CHECK: %[[VAL_38:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_26]]) + + inquire(unit=iounit, id=idvar, pending=pending) +! CHECK: %[[VAL_39:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref +! CHECK: %[[VAL_43:.*]] = fir.call @_FortranAioBeginInquireUnit(%[[VAL_39]], +! CHECK: %[[VAL_44:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref +! CHECK: %[[VAL_46:.*]] = fir.convert %[[VAL_6]]#1 : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_47:.*]] = fir.call @_FortranAioInquirePendingId(%[[VAL_43]], %[[VAL_44]], %[[VAL_46]]) +! CHECK: %[[VAL_48:.*]] = fir.convert %[[VAL_6]]#1 : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_49:.*]] = fir.load %[[VAL_48]] : !fir.ref +! CHECK: %[[VAL_50:.*]] = fir.convert %[[VAL_49]] : (i1) -> !fir.logical<4> +! CHECK: fir.store %[[VAL_50]] to %[[VAL_6]]#1 : !fir.ref> +! CHECK: %[[VAL_51:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_43]]) + + wait(unit=iounit, id=idvar) +! CHECK: %[[VAL_52:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref +! CHECK: %[[VAL_53:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref +! CHECK: %[[VAL_57:.*]] = fir.call @_FortranAioBeginWait(%[[VAL_52]], %[[VAL_53]] +! CHECK: %[[VAL_58:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_57]]) +end subroutine +end module + + use test_async + real :: x(10) = 1. + integer :: iounit = 100 + integer :: idvar + logical :: pending = .true. + call test(x, iounit, idvar, pending) + print *, idvar, pending +end diff --git a/flang/test/Lower/io-statement-1.f90 b/flang/test/Lower/io-statement-1.f90 index 980cdb65033ab..ac7874594d2fc 100644 --- a/flang/test/Lower/io-statement-1.f90 +++ b/flang/test/Lower/io-statement-1.f90 @@ -109,7 +109,7 @@ subroutine inquire_test(ch, i, b) ! PENDING with ID ! CHECK-DAG: %[[chip:.*]] = fir.call {{.*}}BeginInquireUnit ! CHECK-DAG: fir.call @_QPid_func - ! CHECK: call @_FortranAioInquirePendingId(%[[chip]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref, i64, !fir.ref) -> i1 + ! CHECK: call @_FortranAioInquirePendingId(%[[chip]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref, i32, !fir.ref) -> i1 ! CHECK: call {{.*}}EndIoStatement inquire(91, id=id_func(), pending=b) end subroutine inquire_test