[flang] Support FLUSH as an intrinsic subroutine

[Saldivarcher]

Previously FLUSH was only recognized in statement form (e.g. flush(unit)); a
subroutine invocation call flush(unit) was treated as a generic user call with
no special semantics. This change teaches lowering/semantics to handle
CALL FLUSH equivalently.

Fixes #119418

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

@llvm/pr-subscribers-flang-semantics

Author: Miguel Saldivar (Saldivarcher)

Changes

Currently FLUSH was only available as a statement, so something like:

program flush_stmt_example
  implicit none

  integer :: unit

  ! Open a file for writing
  open(unit=10, file="flush_stmt.txt", status="replace", action="write")

  write(10,*) "This line is written to the file."
  flush(10)  ! <-- flush statement, not a CALL

  print *, "The file has been flushed. You can read it now before close."

  close(10)
end program flush_stmt_example

If FLUSH was used as subroutine call, like call flush(10) there was no special handling of it. This PR should add that functionality.

Fixes #119418

---

Full diff: https://github.com/llvm/llvm-project/pull/165942.diff

7 Files Affected:

• (modified) flang-rt/lib/runtime/extensions.cpp (+11)
• (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+1)
• (modified) flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h (+2)
• (modified) flang/include/flang/Runtime/extensions.h (+1)
• (modified) flang/lib/Evaluate/intrinsics.cpp (+4)
• (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+18)
• (modified) flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp (+9)

diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp
index 19e75143705ab..d3a618c1a39ec 100644
--- a/flang-rt/lib/runtime/extensions.cpp
+++ b/flang-rt/lib/runtime/extensions.cpp
@@ -163,6 +163,17 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
   Cookie cookie{IONAME(BeginFlush)(unit, __FILE__, __LINE__)};
   IONAME(EndIoStatement)(cookie);
 }
+
+void RTNAME(Flush)(int unit) {
+  // We set the `unit == -1` on the `flush()` case, so flush all units.
+  if (unit < 0) {
+    Terminator terminator{__FILE__, __LINE__};
+    IoErrorHandler handler{terminator};
+    ExternalFileUnit::FlushAll(handler);
+    return;
+  }
+  FORTRAN_PROCEDURE_NAME(flush)(unit);
+}
 } // namespace io
 
 // CALL FDATE(DATE)
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 3407dd01dd504..51a3ae5af7688 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -278,6 +278,7 @@ struct IntrinsicLibrary {
   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
   void genFenceProxyAsync(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  void genFlush(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genFraction(mlir::Type resultType,
                           mlir::ArrayRef<mlir::Value> args);
   void genFree(mlir::ArrayRef<fir::ExtendedValue> args);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index 7a97172cfbb9a..5121ccce921c6 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -51,6 +51,8 @@ mlir::Value genDsecnds(fir::FirOpBuilder &builder, mlir::Location loc,
 void genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
               mlir::Value values, mlir::Value time);
 
+void genFlush(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value unit);
+
 void genFree(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value ptr);
 
 mlir::Value genFseek(fir::FirOpBuilder &builder, mlir::Location loc,
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 9fd3e118a0f22..8db68eb9c245c 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -34,6 +34,7 @@ double RTNAME(Dsecnds)(double *refTime, const char *sourceFile, int line);
 
 // CALL FLUSH(n) antedates the Fortran 2003 FLUSH statement.
 void FORTRAN_PROCEDURE_NAME(flush)(const int &unit);
+void RTNAME(Flush)(int unit);
 
 // GNU extension subroutine FDATE
 void FORTRAN_PROCEDURE_NAME(fdate)(char *string, std::int64_t length);
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 1de5e6b53ba71..d403afe9de307 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1597,6 +1597,10 @@ static const IntrinsicInterface intrinsicSubroutine[]{
     {"exit", {{"status", DefaultInt, Rank::scalar, Optionality::optional}}, {},
         Rank::elemental, IntrinsicClass::impureSubroutine},
     {"free", {{"ptr", Addressable}}, {}},
+    {"flush",
+        {{"unit", AnyInt, Rank::scalar, Optionality::optional,
+            common::Intent::In}},
+        {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"fseek",
         {{"unit", AnyInt, Rank::scalar}, {"offset", AnyInt, Rank::scalar},
             {"whence", AnyInt, Rank::scalar},
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 15ea84565dd75..317414ef0fec6 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -525,6 +525,10 @@ static constexpr IntrinsicHandler handlers[]{
        {"back", asValue, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"floor", &I::genFloor},
+    {"flush",
+     &I::genFlush,
+     {{{"unit", asValue, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"fraction", &I::genFraction},
     {"free", &I::genFree},
     {"fseek",
@@ -4601,6 +4605,20 @@ mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
   return builder.createConvert(loc, resultType, floor);
 }
 
+// FLUSH
+void IntrinsicLibrary::genFlush(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1);
+
+  mlir::Value unit;
+  if (isStaticallyAbsent(args[0]))
+    // Give a sentinal value of `-1` on the `()` case.
+    unit = builder.createIntegerConstant(loc, builder.getI32Type(), -1);
+  else
+    unit = fir::getBase(args[0]);
+
+  fir::runtime::genFlush(builder, loc, unit);
+}
+
 // FRACTION
 mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
                                           llvm::ArrayRef<mlir::Value> args) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 110b1b20898c7..9fa3b18a255bd 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -137,6 +137,15 @@ void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
   fir::CallOp::create(builder, loc, runtimeFunc, args);
 }
 
+void fir::runtime::genFlush(fir::FirOpBuilder &builder, mlir::Location loc,
+                            mlir::Value unit) {
+  auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Flush)>(loc, builder);
+  llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+      builder, loc, runtimeFunc.getFunctionType(), unit);
+
+  fir::CallOp::create(builder, loc, runtimeFunc, args);
+}
+
 void fir::runtime::genFree(fir::FirOpBuilder &builder, mlir::Location loc,
                            mlir::Value ptr) {
   auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Free)>(loc, builder);