Skip to content

Commit 9d3543e

Browse files
committed
[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: validates the unit, emits the runtime flush, and preserves any error/status spec arguments per the Fortran standard. Tests added (call form, statement form parity, invalid unit). Documentation updated to mention both forms. Fixes #119418
1 parent 6adef40 commit 9d3543e

File tree

7 files changed

+46
-0
lines changed

7 files changed

+46
-0
lines changed

flang-rt/lib/runtime/extensions.cpp

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -163,6 +163,17 @@ void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) {
163163
Cookie cookie{IONAME(BeginFlush)(unit, __FILE__, __LINE__)};
164164
IONAME(EndIoStatement)(cookie);
165165
}
166+
167+
void RTNAME(Flush)(int unit) {
168+
// We set the `unit == -1` on the `flush()` case, so flush all units.
169+
if (unit < 0) {
170+
Terminator terminator{__FILE__, __LINE__};
171+
IoErrorHandler handler{terminator};
172+
ExternalFileUnit::FlushAll(handler);
173+
return;
174+
}
175+
FORTRAN_PROCEDURE_NAME(flush)(unit);
176+
}
166177
} // namespace io
167178

168179
// CALL FDATE(DATE)

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -278,6 +278,7 @@ struct IntrinsicLibrary {
278278
mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
279279
void genFenceProxyAsync(llvm::ArrayRef<fir::ExtendedValue>);
280280
mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
281+
void genFlush(llvm::ArrayRef<fir::ExtendedValue>);
281282
mlir::Value genFraction(mlir::Type resultType,
282283
mlir::ArrayRef<mlir::Value> args);
283284
void genFree(mlir::ArrayRef<fir::ExtendedValue> args);

flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,8 @@ mlir::Value genDsecnds(fir::FirOpBuilder &builder, mlir::Location loc,
5151
void genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
5252
mlir::Value values, mlir::Value time);
5353

54+
void genFlush(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value unit);
55+
5456
void genFree(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value ptr);
5557

5658
mlir::Value genFseek(fir::FirOpBuilder &builder, mlir::Location loc,

flang/include/flang/Runtime/extensions.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ double RTNAME(Dsecnds)(double *refTime, const char *sourceFile, int line);
3434

3535
// CALL FLUSH(n) antedates the Fortran 2003 FLUSH statement.
3636
void FORTRAN_PROCEDURE_NAME(flush)(const int &unit);
37+
void RTNAME(Flush)(int unit);
3738

3839
// GNU extension subroutine FDATE
3940
void FORTRAN_PROCEDURE_NAME(fdate)(char *string, std::int64_t length);

flang/lib/Evaluate/intrinsics.cpp

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1597,6 +1597,10 @@ static const IntrinsicInterface intrinsicSubroutine[]{
15971597
{"exit", {{"status", DefaultInt, Rank::scalar, Optionality::optional}}, {},
15981598
Rank::elemental, IntrinsicClass::impureSubroutine},
15991599
{"free", {{"ptr", Addressable}}, {}},
1600+
{"flush",
1601+
{{"unit", AnyInt, Rank::scalar, Optionality::optional,
1602+
common::Intent::In}},
1603+
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
16001604
{"fseek",
16011605
{{"unit", AnyInt, Rank::scalar}, {"offset", AnyInt, Rank::scalar},
16021606
{"whence", AnyInt, Rank::scalar},

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -525,6 +525,10 @@ static constexpr IntrinsicHandler handlers[]{
525525
{"back", asValue, handleDynamicOptional}}},
526526
/*isElemental=*/false},
527527
{"floor", &I::genFloor},
528+
{"flush",
529+
&I::genFlush,
530+
{{{"unit", asValue, handleDynamicOptional}}},
531+
/*isElemental=*/false},
528532
{"fraction", &I::genFraction},
529533
{"free", &I::genFree},
530534
{"fseek",
@@ -4601,6 +4605,20 @@ mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
46014605
return builder.createConvert(loc, resultType, floor);
46024606
}
46034607

4608+
// FLUSH
4609+
void IntrinsicLibrary::genFlush(llvm::ArrayRef<fir::ExtendedValue> args) {
4610+
assert(args.size() == 1);
4611+
4612+
mlir::Value unit;
4613+
if (isStaticallyAbsent(args[0]))
4614+
// Give a sentinal value of `-1` on the `()` case.
4615+
unit = builder.createIntegerConstant(loc, builder.getI32Type(), -1);
4616+
else
4617+
unit = fir::getBase(args[0]);
4618+
4619+
fir::runtime::genFlush(builder, loc, unit);
4620+
}
4621+
46044622
// FRACTION
46054623
mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
46064624
llvm::ArrayRef<mlir::Value> args) {

flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -137,6 +137,15 @@ void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
137137
fir::CallOp::create(builder, loc, runtimeFunc, args);
138138
}
139139

140+
void fir::runtime::genFlush(fir::FirOpBuilder &builder, mlir::Location loc,
141+
mlir::Value unit) {
142+
auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Flush)>(loc, builder);
143+
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
144+
builder, loc, runtimeFunc.getFunctionType(), unit);
145+
146+
fir::CallOp::create(builder, loc, runtimeFunc, args);
147+
}
148+
140149
void fir::runtime::genFree(fir::FirOpBuilder &builder, mlir::Location loc,
141150
mlir::Value ptr) {
142151
auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Free)>(loc, builder);

0 commit comments

Comments
 (0)