[flang] Lower ASYNCHRONOUS variables and IO statements (#80008)

jeanPerier · web-flow · commit 4679132a85c6 · 2024-01-31T15:54:15.000+01:00
Finish plugging-in ASYNCHRONOUS IO in lowering (GetAsynchronousId was
not used yet).

Add a runtime implementation for GetAsynchronousId (only the signature
was defined). Always return zero since flang runtime "fakes"
asynchronous IO (data transfer are always complete, see
flang/docs/IORuntimeInternals.md).

Update all runtime integer argument and results for IDs to use the
AsynchronousId int alias for consistency.

In lowering, asynchronous attribute is added on the hlfir.declare of
ASYNCHRONOUS variable, but nothing else is done. This is OK given the
synchronous aspects of flang IO, but it would be safer to treat these
variable as volatile (prevent code motion of related store/loads) since
the asynchronous data change can also be done by C defined user
procedure (see 18.10.4 Asynchronous communication). Flang lowering
anyway does not give enough info for LLVM to do such code motions (the
variables that are passed in a call are not given the noescape
attribute, so LLVM will assume any later opaque call may modify the
related data and would not move load/stores of such variables
before/after calls even if it could from a pure Fortran point of view
without ASYNCHRONOUS).
diff --git 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
@@ -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
@@ -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);
diff --git 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<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);
 }
diff --git a/flang/test/Lower/io-asynchronous.f90 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<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
diff --git 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<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
