[flang] [llvm] [flang] Support FLUSH as an intrinsic subroutine (PR #165942)
Miguel Saldivar via llvm-commits
llvm-commits at lists.llvm.org
Sun Nov 16 22:08:13 PST 2025
https://github.com/Saldivarcher updated https://github.com/llvm/llvm-project/pull/165942
>From 9deab44edc97734f8d8069f56bf67c567bf3acfe Mon Sep 17 00:00:00 2001
From: Miguel Saldivar <saldivarcher at gmail.com>
Date: Fri, 31 Oct 2025 16:46:49 -0700
Subject: [PATCH] [flang] Support `FLUSH` as an intrinsic subroutine
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
---
flang-rt/lib/runtime/extensions.cpp | 11 +++++
.../flang/Optimizer/Builder/IntrinsicCall.h | 1 +
.../Optimizer/Builder/Runtime/Intrinsics.h | 2 +
flang/include/flang/Runtime/extensions.h | 1 +
flang/lib/Evaluate/intrinsics.cpp | 4 ++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 49 ++++++++++++++++---
.../Optimizer/Builder/Runtime/Intrinsics.cpp | 9 ++++
flang/test/Lower/Intrinsics/flush.f90 | 41 ++++++++++++++++
8 files changed, 112 insertions(+), 6 deletions(-)
create mode 100644 flang/test/Lower/Intrinsics/flush.f90
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 01d27fd5fc399..421f1d035ecdb 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -254,6 +254,7 @@ struct IntrinsicLibrary {
template <Extremum, ExtremumBehavior>
mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
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 3eb60448fae38..ceca6d7ce076a 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -91,6 +91,11 @@ static bool isStaticallyAbsent(llvm::ArrayRef<mlir::Value> args,
size_t argIndex) {
return args.size() <= argIndex || !args[argIndex];
}
+static bool isOptional(mlir::Value value) {
+ auto varIface = mlir::dyn_cast_or_null<fir::FortranVariableOpInterface>(
+ value.getDefiningOp());
+ return varIface && varIface.isOptional();
+}
/// Test if an ExtendedValue is present. This is used to test if an intrinsic
/// argument is present at compile time. This does not imply that the related
@@ -303,6 +308,10 @@ static constexpr IntrinsicHandler handlers[]{
{"back", asValue, handleDynamicOptional}}},
/*isElemental=*/false},
{"floor", &I::genFloor},
+ {"flush",
+ &I::genFlush,
+ {{{"unit", asAddr}}},
+ /*isElemental=*/false},
{"fraction", &I::genFraction},
{"free", &I::genFree},
{"fseek",
@@ -3934,6 +3943,40 @@ 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]);
+ if (isOptional(unit)) {
+ mlir::Value isPresent =
+ fir::IsPresentOp::create(builder, loc, builder.getI1Type(), unit);
+ unit = builder
+ .genIfOp(loc, builder.getI32Type(), isPresent,
+ /*withElseRegion=*/true)
+ .genThen([&]() {
+ mlir::Value loaded = fir::LoadOp::create(builder, loc, unit);
+ fir::ResultOp::create(builder, loc, loaded);
+ })
+ .genElse([&]() {
+ mlir::Value negOne = builder.createIntegerConstant(
+ loc, builder.getI32Type(), -1);
+ fir::ResultOp::create(builder, loc, negOne);
+ })
+ .getResults()[0];
+ } else {
+ unit = fir::LoadOp::create(builder, loc, unit);
+ }
+ }
+
+ fir::runtime::genFlush(builder, loc, unit);
+}
+
// FRACTION
mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
@@ -6281,12 +6324,6 @@ IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,
fir::getBase(args[1]), fir::getLen(args[1]));
}
-static bool isOptional(mlir::Value value) {
- auto varIface = mlir::dyn_cast_or_null<fir::FortranVariableOpInterface>(
- value.getDefiningOp());
- return varIface && varIface.isOptional();
-}
-
// LOC
fir::ExtendedValue
IntrinsicLibrary::genLoc(mlir::Type resultType,
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);
diff --git a/flang/test/Lower/Intrinsics/flush.f90 b/flang/test/Lower/Intrinsics/flush.f90
new file mode 100644
index 0000000000000..2b02179d84c79
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/flush.f90
@@ -0,0 +1,41 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+!
+! Test lowering of intrinsic subroutine FLUSH with and without optional UNIT argument.
+!
+! CHECK-LABEL: func.func @_QPflush_all()
+! CHECK: %[[UNIT:.*]] = arith.constant -1 : i32
+! CHECK: fir.call @_FortranAFlush(%[[UNIT]]) fastmath<contract> : (i32) -> ()
+! CHECK: return
+subroutine flush_all()
+ call flush() ! flush all units
+end subroutine
+
+! CHECK-LABEL: func.func @_QPflush_unit()
+! CHECK: %[[ALLOCA:.*]] = fir.alloca i32
+! CHECK: %[[UNITC:.*]] = arith.constant 10 : i32
+! CHECK: fir.store %[[UNITC]] to %[[ALLOCA]] : !fir.ref<i32>
+! CHECK: %[[LOADED:.*]] = fir.load %[[ALLOCA]] : !fir.ref<i32>
+! CHECK: fir.call @_FortranAFlush(%[[LOADED]]) fastmath<contract> : (i32) -> ()
+! CHECK: return
+subroutine flush_unit()
+ call flush(10) ! flush specific unit
+end subroutine
+
+! CHECK-LABEL: func.func @_QPflush_optional(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<i32> {fir.bindc_name = "unit", fir.optional}) {
+! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFflush_optionalEunit"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK: %[[IS_PRESENT:.*]] = fir.is_present %[[DECL]]#0 : (!fir.ref<i32>) -> i1
+! CHECK: %[[UNIT:.*]] = fir.if %[[IS_PRESENT]] -> (i32) {
+! CHECK: %[[LOADED:.*]] = fir.load %[[DECL]]#0 : !fir.ref<i32>
+! CHECK: fir.result %[[LOADED]] : i32
+! CHECK: } else {
+! CHECK: %[[DEFAULT:.*]] = arith.constant -1 : i32
+! CHECK: fir.result %[[DEFAULT]] : i32
+! CHECK: }
+! CHECK: fir.call @_FortranAFlush(%[[UNIT]]) fastmath<contract> : (i32) -> ()
+! CHECK: return
+subroutine flush_optional(unit)
+ integer, optional :: unit
+ call flush(unit) ! flush with dynamically optional argument
+end subroutine
More information about the llvm-commits
mailing list