[flang] Lower ASYNCHRONOUS variables and IO statements

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);

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))

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<Fortran::parser::IoControlSpec::Asynchronous>(
                                                    spec.v);
 }
 
-template <>
-mlir::Value genIOOption<Fortran::parser::IdVariable>(
-    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::parser::IoControlSpec::Pos>(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
@@ -1334,35 +1328,21 @@ mlir::Value genIOOption<Fortran::parser::IoControlSpec::Rec>(
   return genIntIOOption<mkIOKey(SetRec)>(converter, loc, cookie, spec);
 }
 
-/// Generate runtime call to query the read size after an input statement if
-/// the statement has SIZE control-spec.
-template <typename A>
-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<Fortran::parser::IoControlSpec::Size>(&spec.u)) {
-
-      fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-      mlir::func::FuncOp ioFunc =
-          getIORuntimeFunc<mkIOKey(GetSize)>(loc, builder);
-      auto sizeValue =
-          builder.create<fir::CallOp>(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<fir::StoreOp>(loc, sizeCast, varAddr);
-      break;
-    }
+/// Generate runtime call to set some control variable.
+/// Generates "VAR = IoRuntimeKey(cookie)".
+template <typename IoRuntimeKey, typename VAR>
+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<IoRuntimeKey>(loc, builder);
+  mlir::Value value =
+      builder.create<fir::CallOp>(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<Fortran::parser::PrintStmt>(
   return std::nullopt;
 }
 
-template <typename A>
-static bool isDataTransferAsynchronous(mlir::Location loc, const A &stmt) {
-  if (auto *asynch =
-          getIOControl<Fortran::parser::IoControlSpec::Asynchronous>(stmt)) {
-    // FIXME: should contain a string of YES or NO
-    TODO(loc, "asynchronous transfers not implemented in runtime");
-  }
-  return false;
-}
-template <>
-bool isDataTransferAsynchronous<Fortran::parser::PrintStmt>(
-    mlir::Location, const Fortran::parser::PrintStmt &) {
-  return false;
-}
-
 template <typename A>
 static bool isDataTransferNamelist(const A &stmt) {
   if (stmt.format)
@@ -2043,7 +2014,7 @@ template <bool isInput>
 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<fir::ExtendedValue> &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<isInput>(
       loc, builder, isFormatted, isList || isNml, isInternal,
-      isInternalWithDesc, isAsync);
+      isInternalWithDesc);
   llvm::SmallVector<mlir::Value> 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<fir::CallOp>(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<Fortran::parser::IoControlSpec::Size>(&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<mkIOKey(GetSize)>(converter, loc, cookie, *size);
+      } else if (const auto *idVar =
+                     std::get_if<Fortran::parser::IdVariable>(&spec.u)) {
+        genIOGetVar<mkIOKey(GetAsynchronousId)>(converter, loc, cookie, *idVar);
+      }
   }
   // Generate end statement call/s.
   mlir::Value result = genEndIO(converter, loc, cookie, csi, stmtCtx);

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<ExternalIoStatementBase>()}) {
+    return ext->asynchronousID();
+  } else if (!io.get_if<NoopStatementState>() &&
+      !io.get_if<ErroneousIoStatementState>()) {
+    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);
 }

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<asynchronous>{{.*}}x
+
+  open(unit=iounit, asynchronous='yes')
+! CHECK:           %[[VAL_10:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref<i32>
+! 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<i32>
+! 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<i32>
+! 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<i32>
+! CHECK:           %[[VAL_43:.*]] = fir.call @_FortranAioBeginInquireUnit(%[[VAL_39]],
+! CHECK:           %[[VAL_44:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref<i32>
+! CHECK:           %[[VAL_46:.*]] = fir.convert %[[VAL_6]]#1 : (!fir.ref<!fir.logical<4>>) -> !fir.ref<i1>
+! CHECK:           %[[VAL_47:.*]] = fir.call @_FortranAioInquirePendingId(%[[VAL_43]], %[[VAL_44]], %[[VAL_46]])
+! CHECK:           %[[VAL_48:.*]] = fir.convert %[[VAL_6]]#1 : (!fir.ref<!fir.logical<4>>) -> !fir.ref<i1>
+! CHECK:           %[[VAL_49:.*]] = fir.load %[[VAL_48]] : !fir.ref<i1>
+! CHECK:           %[[VAL_50:.*]] = fir.convert %[[VAL_49]] : (i1) -> !fir.logical<4>
+! CHECK:           fir.store %[[VAL_50]] to %[[VAL_6]]#1 : !fir.ref<!fir.logical<4>>
+! CHECK:           %[[VAL_51:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_43]])
+
+  wait(unit=iounit, id=idvar)
+! CHECK:           %[[VAL_52:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref<i32>
+! CHECK:           %[[VAL_53:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref<i32>
+! 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

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<i8>, i64, !fir.ref<i1>) -> i1
+  ! CHECK: call @_FortranAioInquirePendingId(%[[chip]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<i8>, i32, !fir.ref<i1>) -> i1
   ! CHECK: call {{.*}}EndIoStatement
   inquire(91, id=id_func(), pending=b)
 end subroutine inquire_test