[flang] [llvm] [flang] Implement FSEEK and FTELL (PR #133003)
Peter Klausler via llvm-commits
llvm-commits at lists.llvm.org
Wed Mar 26 12:20:56 PDT 2025
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/133003
>From 7eba8eecb49ec221537494f0e41cf60936d53a05 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 21 Mar 2025 13:08:16 -0700
Subject: [PATCH] [flang] Implement FSEEK and FTELL
Add function and subroutine forms of FSEEK and FTELL as intrinsic
procedures. Accept common aliases from legacy compilers as well.
A separate patch to llvm-test-suite will enable tests for these
procedures once this patch has merged.
Depends on https://github.com/llvm/llvm-project/pull/132423;
CI builds will likely fail until that patch is merged and this
PR is rebased.
---
flang-rt/lib/runtime/extensions.cpp | 30 ++++++++
flang-rt/lib/runtime/unit.cpp | 46 ++++++++++--
flang-rt/lib/runtime/unit.h | 14 +++-
flang/docs/Intrinsics.md | 35 +++++++++
.../flang/Optimizer/Builder/IntrinsicCall.h | 4 +
.../Optimizer/Builder/Runtime/Intrinsics.h | 5 ++
flang/include/flang/Runtime/extensions.h | 5 ++
flang/lib/Evaluate/intrinsics.cpp | 30 +++++++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 74 +++++++++++++++++++
.../Optimizer/Builder/Runtime/Intrinsics.cpp | 24 ++++++
10 files changed, 252 insertions(+), 15 deletions(-)
diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp
index 7e9e512778a75..c4e0fe66407c4 100644
--- a/flang-rt/lib/runtime/extensions.cpp
+++ b/flang-rt/lib/runtime/extensions.cpp
@@ -10,12 +10,14 @@
// extensions that will eventually be implemented in Fortran.
#include "flang/Runtime/extensions.h"
+#include "unit.h"
#include "flang-rt/runtime/descriptor.h"
#include "flang-rt/runtime/terminator.h"
#include "flang-rt/runtime/tools.h"
#include "flang/Runtime/command.h"
#include "flang/Runtime/entry-names.h"
#include "flang/Runtime/io-api.h"
+#include "flang/Runtime/iostat-consts.h"
#include <chrono>
#include <cstring>
#include <ctime>
@@ -268,5 +270,33 @@ void FORTRAN_PROCEDURE_NAME(qsort)(int *array, int *len, int *isize,
qsort(array, *len, *isize, compar);
}
+// Extension procedures related to I/O
+
+namespace io {
+std::int32_t RTNAME(Fseek)(int unitNumber, std::int64_t zeroBasedPos,
+ int whence, const char *sourceFileName, int lineNumber) {
+ if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
+ Terminator terminator{sourceFileName, lineNumber};
+ IoErrorHandler handler{terminator};
+ if (unit->Fseek(
+ zeroBasedPos, static_cast<enum FseekWhence>(whence), handler)) {
+ return IostatOk;
+ } else {
+ return IostatCannotReposition;
+ }
+ } else {
+ return IostatBadUnitNumber;
+ }
+}
+
+std::int64_t RTNAME(Ftell)(int unitNumber) {
+ if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
+ return unit->InquirePos() - 1; // zero-based result
+ } else {
+ return -1;
+ }
+}
+} // namespace io
+
} // namespace Fortran::runtime
} // extern "C"
diff --git a/flang-rt/lib/runtime/unit.cpp b/flang-rt/lib/runtime/unit.cpp
index 43501aeb48458..2e8a5e34eb123 100644
--- a/flang-rt/lib/runtime/unit.cpp
+++ b/flang-rt/lib/runtime/unit.cpp
@@ -441,14 +441,14 @@ void ExternalFileUnit::Rewind(IoErrorHandler &handler) {
"REWIND(UNIT=%d) on non-sequential file", unitNumber());
} else {
DoImpliedEndfile(handler);
- SetPosition(0, handler);
+ SetPosition(0);
currentRecordNumber = 1;
leftTabLimit.reset();
anyWriteSinceLastPositioning_ = false;
}
}
-void ExternalFileUnit::SetPosition(std::int64_t pos, IoErrorHandler &handler) {
+void ExternalFileUnit::SetPosition(std::int64_t pos) {
frameOffsetInFile_ = pos;
recordOffsetInFrame_ = 0;
if (access == Access::Direct) {
@@ -457,6 +457,19 @@ void ExternalFileUnit::SetPosition(std::int64_t pos, IoErrorHandler &handler) {
BeginRecord();
}
+void ExternalFileUnit::Sought(
+ std::int64_t zeroBasedPos, IoErrorHandler &handler) {
+ SetPosition(zeroBasedPos);
+ if (zeroBasedPos == 0) {
+ currentRecordNumber = 1;
+ } else {
+ // We no longer know which record we're in. Set currentRecordNumber to
+ // a large value from whence we can both advance and backspace.
+ currentRecordNumber = std::numeric_limits<std::int64_t>::max() / 2;
+ endfileRecordNumber.reset();
+ }
+}
+
bool ExternalFileUnit::SetStreamPos(
std::int64_t oneBasedPos, IoErrorHandler &handler) {
if (access != Access::Stream) {
@@ -474,14 +487,31 @@ bool ExternalFileUnit::SetStreamPos(
frameOffsetInFile_ + recordOffsetInFrame_) {
DoImpliedEndfile(handler);
}
- SetPosition(oneBasedPos - 1, handler);
- // We no longer know which record we're in. Set currentRecordNumber to
- // a large value from whence we can both advance and backspace.
- currentRecordNumber = std::numeric_limits<std::int64_t>::max() / 2;
- endfileRecordNumber.reset();
+ Sought(oneBasedPos - 1, handler);
return true;
}
+// GNU FSEEK extension
+RT_API_ATTRS bool ExternalFileUnit::Fseek(std::int64_t zeroBasedPos,
+ enum FseekWhence whence, IoErrorHandler &handler) {
+ if (whence == FseekEnd) {
+ Flush(handler); // updates knownSize_
+ if (auto size{knownSize()}) {
+ zeroBasedPos += *size;
+ } else {
+ return false;
+ }
+ } else if (whence == FseekCurrent) {
+ zeroBasedPos += InquirePos() - 1;
+ }
+ if (zeroBasedPos >= 0) {
+ Sought(zeroBasedPos, handler);
+ return true;
+ } else {
+ return false;
+ }
+}
+
bool ExternalFileUnit::SetDirectRec(
std::int64_t oneBasedRec, IoErrorHandler &handler) {
if (access != Access::Direct) {
@@ -498,7 +528,7 @@ bool ExternalFileUnit::SetDirectRec(
return false;
}
currentRecordNumber = oneBasedRec;
- SetPosition((oneBasedRec - 1) * *openRecl, handler);
+ SetPosition((oneBasedRec - 1) * *openRecl);
return true;
}
diff --git a/flang-rt/lib/runtime/unit.h b/flang-rt/lib/runtime/unit.h
index bb3d3650da34b..34bb1e44f448b 100644
--- a/flang-rt/lib/runtime/unit.h
+++ b/flang-rt/lib/runtime/unit.h
@@ -33,6 +33,12 @@ class UnitMap;
class ChildIo;
class ExternalFileUnit;
+enum FseekWhence {
+ FseekSet = 0,
+ FseekCurrent = 1,
+ FseekEnd = 2,
+};
+
RT_OFFLOAD_VAR_GROUP_BEGIN
// Predefined file units.
extern RT_VAR_ATTRS ExternalFileUnit *defaultInput; // unit 5
@@ -176,8 +182,9 @@ class ExternalFileUnit : public ConnectionState,
RT_API_ATTRS void Endfile(IoErrorHandler &);
RT_API_ATTRS void Rewind(IoErrorHandler &);
RT_API_ATTRS void EndIoStatement();
- RT_API_ATTRS bool SetStreamPos(
- std::int64_t, IoErrorHandler &); // one-based, for POS=
+ RT_API_ATTRS bool SetStreamPos(std::int64_t oneBasedPos, IoErrorHandler &);
+ RT_API_ATTRS bool Fseek(
+ std::int64_t zeroBasedPos, enum FseekWhence, IoErrorHandler &);
RT_API_ATTRS bool SetDirectRec(
std::int64_t, IoErrorHandler &); // one-based, for REC=
RT_API_ATTRS std::int64_t InquirePos() const {
@@ -196,7 +203,8 @@ class ExternalFileUnit : public ConnectionState,
static RT_API_ATTRS UnitMap &CreateUnitMap();
static RT_API_ATTRS UnitMap &GetUnitMap();
RT_API_ATTRS const char *FrameNextInput(IoErrorHandler &, std::size_t);
- RT_API_ATTRS void SetPosition(std::int64_t, IoErrorHandler &); // zero-based
+ RT_API_ATTRS void SetPosition(std::int64_t zeroBasedPos);
+ RT_API_ATTRS void Sought(std::int64_t zeroBasedPos, IoErrorHandler &);
RT_API_ATTRS void BeginSequentialVariableUnformattedInputRecord(
IoErrorHandler &);
RT_API_ATTRS void BeginVariableFormattedInputRecord(IoErrorHandler &);
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index c5c45c2f87d35..9b786f819eb82 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1128,6 +1128,41 @@ program chdir_func
end program chdir_func
```
+### Non-Standard Intrinsics: FSEEK and FTELL
+
+#### Description
+`FSEEK(UNIT, OFFSET, WHENCE)` Sets position in file opened as `UNIT`, returns status.
+
+`CALL FSEEK(UNIT, OFFSET, WHENCE[, STATUS])` Sets position, returns any error in `STATUS` if present.
+
+`FTELL(UNIT)` Returns current absolute byte offset.
+
+`CALL FTELL(UNIT, OFFSET)` Set `OFFSET` to current byte offset in file.
+
+These intrinsic procedures are available as both functions and subroutines,
+but both forms cannot be used in the same scope.
+
+| | |
+|------------|-------------------------------------------------|
+| `UNIT` | An open unit number |
+| `OFFSET` | A byte offset; set to -1 by `FTELL` on error |
+| `WHENCE` | 0: `OFFSET` is an absolute position |
+| | 1: `OFFSET` is relative to the current position |
+| | 2: `OFFSET` is relative to the end of the file |
+| `STATUS` | Set to a nonzero value if an error occurs |
+|------------|-------------------------------------------------|
+
+The aliases `FSEEK64`, `FSEEKO64`, `FSEEKI8`, `FTELL64`, `FTELLO64`, and
+`FTELLI8` are also accepted for further compatibility.
+
+Avoid using these intrinsics in new code when the standard `ACCESS="STREAM"`
+feature meets your needs.
+
+#### Usage and Info
+
+- **Standard:** Extensions to GNU, Intel, and SUN (at least)
+- **Class:** Subroutine, function
+
### Non-Standard Intrinsics: IERRNO
#### Description
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index cdbb78224e3b4..00e9ca1c98961 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -266,6 +266,10 @@ struct IntrinsicLibrary {
mlir::Value genFraction(mlir::Type resultType,
mlir::ArrayRef<mlir::Value> args);
void genFree(mlir::ArrayRef<fir::ExtendedValue> args);
+ fir::ExtendedValue genFseek(std::optional<mlir::Type>,
+ mlir::ArrayRef<fir::ExtendedValue> args);
+ fir::ExtendedValue genFtell(std::optional<mlir::Type>,
+ mlir::ArrayRef<fir::ExtendedValue> args);
fir::ExtendedValue genGetCwd(std::optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args);
void genGetCommand(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 51d2dc82f98ae..4562134f4ecb5 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -49,6 +49,11 @@ void genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
void genFree(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value ptr);
+mlir::Value genFseek(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value unit, mlir::Value offset, mlir::Value whence);
+mlir::Value genFtell(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value unit);
+
mlir::Value genGetUID(fir::FirOpBuilder &, mlir::Location);
mlir::Value genGetGID(fir::FirOpBuilder &, mlir::Location);
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 4e96f253a6c2c..0d823cb3db902 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -38,6 +38,11 @@ void FORTRAN_PROCEDURE_NAME(fdate)(char *string, std::int64_t length);
void RTNAME(Free)(std::intptr_t ptr);
+// Common extensions FSEEK & FTELL, variously named
+std::int32_t RTNAME(Fseek)(int unit, std::int64_t zeroBasedPos, int whence,
+ const char *sourceFileName, int lineNumber);
+std::int64_t RTNAME(Ftell)(int unit);
+
// GNU Fortran 77 compatibility function IARGC.
std::int32_t FORTRAN_PROCEDURE_NAME(iargc)();
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index dc0ccd2cb342a..b9a28bd40f0a2 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -543,6 +543,12 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
KINDInt, Rank::vector, IntrinsicClass::transformationalFunction},
{"floor", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
{"fraction", {{"x", SameReal}}, SameReal},
+ {"fseek",
+ {{"unit", AnyInt, Rank::scalar}, {"offset", AnyInt, Rank::scalar},
+ {"whence", AnyInt, Rank::scalar}},
+ DefaultInt, Rank::scalar},
+ {"ftell", {{"unit", AnyInt, Rank::scalar}},
+ TypePattern{IntType, KindCode::exactKind, 8}, Rank::scalar},
{"gamma", {{"x", SameReal}}, SameReal},
{"get_team", {{"level", DefaultInt, Rank::scalar, Optionality::optional}},
TeamType, Rank::scalar, IntrinsicClass::transformationalFunction},
@@ -1077,11 +1083,16 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
// LOC, probably others
// TODO: Optionally warn on operand promotion extension
-// Aliases for a few generic intrinsic functions for legacy
-// compatibility and builtins.
+// Aliases for a few generic procedures for legacy compatibility and builtins.
static const std::pair<const char *, const char *> genericAlias[]{
{"and", "iand"},
{"getenv", "get_environment_variable"},
+ {"fseek64", "fseek"},
+ {"fseeko64", "fseek"}, // SUN
+ {"fseeki8", "fseek"}, // Intel
+ {"ftell64", "ftell"},
+ {"ftello64", "ftell"}, // SUN
+ {"ftelli8", "ftell"}, // Intel
{"imag", "aimag"},
{"lshift", "shiftl"},
{"or", "ior"},
@@ -1510,6 +1521,17 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"exit", {{"status", DefaultInt, Rank::scalar, Optionality::optional}}, {},
Rank::elemental, IntrinsicClass::impureSubroutine},
{"free", {{"ptr", Addressable}}, {}},
+ {"fseek",
+ {{"unit", AnyInt, Rank::scalar}, {"offset", AnyInt, Rank::scalar},
+ {"whence", AnyInt, Rank::scalar},
+ {"status", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::InOut}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"ftell",
+ {{"unit", AnyInt, Rank::scalar},
+ {"offset", AnyInt, Rank::scalar, Optionality::required,
+ common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"get_command",
{{"command", DefaultChar, Rank::scalar, Optionality::optional,
common::Intent::Out},
@@ -2774,8 +2796,8 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
const std::string &name) const {
// Collection for some intrinsics with function and subroutine form,
// in order to pass the semantic check.
- static const std::string dualIntrinsic[]{{"chdir"s}, {"etime"s}, {"getcwd"s},
- {"hostnm"s}, {"rename"s}, {"second"s}, {"system"s}};
+ static const std::string dualIntrinsic[]{{"chdir"}, {"etime"}, {"fseek"},
+ {"ftell"}, {"getcwd"}, {"hostnm"}, {"rename"}, {"second"}, {"system"}};
return llvm::is_contained(dualIntrinsic, name);
}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index e1e2fa875bff3..1aed0b1d4e215 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -449,6 +449,17 @@ static constexpr IntrinsicHandler handlers[]{
{"floor", &I::genFloor},
{"fraction", &I::genFraction},
{"free", &I::genFree},
+ {"fseek",
+ &I::genFseek,
+ {{{"unit", asValue},
+ {"offset", asValue},
+ {"whence", asValue},
+ {"status", asAddr, handleDynamicOptional}}},
+ /*isElemental=*/false},
+ {"ftell",
+ &I::genFtell,
+ {{{"unit", asValue}, {"offset", asAddr}}},
+ /*isElemental=*/false},
{"get_command",
&I::genGetCommand,
{{{"command", asBox, handleDynamicOptional},
@@ -4117,6 +4128,69 @@ void IntrinsicLibrary::genFree(llvm::ArrayRef<fir::ExtendedValue> args) {
fir::runtime::genFree(builder, loc, fir::getBase(args[0]));
}
+// FSEEK
+fir::ExtendedValue
+IntrinsicLibrary::genFseek(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert((args.size() == 4 && !resultType.has_value()) ||
+ (args.size() == 3 && resultType.has_value()));
+ mlir::Value unit = fir::getBase(args[0]);
+ mlir::Value offset = fir::getBase(args[1]);
+ mlir::Value whence = fir::getBase(args[2]);
+ if (!unit)
+ fir::emitFatalError(loc, "expected UNIT argument");
+ if (!offset)
+ fir::emitFatalError(loc, "expected OFFSET argument");
+ if (!whence)
+ fir::emitFatalError(loc, "expected WHENCE argument");
+ mlir::Value statusValue =
+ fir::runtime::genFseek(builder, loc, unit, offset, whence);
+ if (resultType.has_value()) { // function
+ return statusValue;
+ } else { // subroutine
+ const fir::ExtendedValue &statusVar = args[3];
+ if (!isStaticallyAbsent(statusVar)) {
+ mlir::Value statusAddr = fir::getBase(statusVar);
+ mlir::Value statusIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, statusAddr);
+ builder.genIfThen(loc, statusIsPresentAtRuntime)
+ .genThen([&]() {
+ builder.createStoreWithConvert(loc, statusValue, statusAddr);
+ })
+ .end();
+ }
+ return {};
+ }
+}
+
+// FTELL
+fir::ExtendedValue
+IntrinsicLibrary::genFtell(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert((args.size() == 2 && !resultType.has_value()) ||
+ (args.size() == 1 && resultType.has_value()));
+ mlir::Value unit = fir::getBase(args[0]);
+ if (!unit)
+ fir::emitFatalError(loc, "expected UNIT argument");
+ mlir::Value offsetValue = fir::runtime::genFtell(builder, loc, unit);
+ if (resultType.has_value()) { // function
+ return offsetValue;
+ } else { // subroutine
+ const fir::ExtendedValue &offsetVar = args[1];
+ if (!isStaticallyAbsent(offsetVar)) {
+ mlir::Value offsetAddr = fir::getBase(offsetVar);
+ mlir::Value offsetIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, offsetAddr);
+ builder.genIfThen(loc, offsetIsPresentAtRuntime)
+ .genThen([&]() {
+ builder.createStoreWithConvert(loc, offsetValue, offsetAddr);
+ })
+ .end();
+ }
+ return {};
+ }
+}
+
// GETCWD
fir::ExtendedValue
IntrinsicLibrary::genGetCwd(std::optional<mlir::Type> resultType,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 2f46e7605fe91..dd091e4f23c9c 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -128,6 +128,30 @@ void fir::runtime::genFree(fir::FirOpBuilder &builder, mlir::Location loc,
builder.createConvert(loc, intPtrTy, ptr));
}
+mlir::Value fir::runtime::genFseek(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value unit,
+ mlir::Value offset, mlir::Value whence) {
+ auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Fseek)>(loc, builder);
+ mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
+ mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+ mlir::Value sourceLine =
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));
+ llvm::SmallVector<mlir::Value> args =
+ fir::runtime::createArguments(builder, loc, runtimeFuncTy, unit, offset,
+ whence, sourceFile, sourceLine);
+ return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
+ ;
+}
+
+mlir::Value fir::runtime::genFtell(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value unit) {
+ auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Ftell)>(loc, builder);
+ mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
+ llvm::SmallVector<mlir::Value> args =
+ fir::runtime::createArguments(builder, loc, runtimeFuncTy, unit);
+ return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
+}
+
mlir::Value fir::runtime::genGetGID(fir::FirOpBuilder &builder,
mlir::Location loc) {
auto runtimeFunc =
More information about the llvm-commits
mailing list