[flang-commits] [flang] a5a29a2 - [Flang] Implement RENAME intrinsic (code-gen + runtime entry point) (#98359)
via flang-commits
flang-commits at lists.llvm.org
Sun Jul 14 23:39:22 PDT 2024
Author: Michael Klemm
Date: 2024-07-15T08:39:19+02:00
New Revision: a5a29a26aaf0d7e63101471250d32e9b7230fe73
URL: https://github.com/llvm/llvm-project/commit/a5a29a26aaf0d7e63101471250d32e9b7230fe73
DIFF: https://github.com/llvm/llvm-project/commit/a5a29a26aaf0d7e63101471250d32e9b7230fe73.diff
LOG: [Flang] Implement RENAME intrinsic (code-gen + runtime entry point) (#98359)
This PR implements the RENAME intrinsic, which is a GFortran extension
(see
https://gcc.gnu.org/onlinedocs/gfortran/intrinsic-procedures/rename.html).
Added:
flang/test/Lower/Intrinsics/rename.f90
Modified:
flang/docs/Intrinsics.md
flang/include/flang/Optimizer/Builder/IntrinsicCall.h
flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
flang/include/flang/Runtime/misc-intrinsic.h
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
flang/runtime/misc-intrinsic.cpp
flang/test/Lower/namelist.f90
Removed:
################################################################################
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 1fdf22daf3688..3009f25d39c2b 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1001,3 +1001,49 @@ PROGRAM example_getcwd
PRINT *, status
END PROGRAM
```
+
+### Non-standard Intrinsics: RENAME
+`RENAME(OLD, NEW[, STATUS])` renames/moves a file on the filesystem.
+
+This intrinsic is provided in both subroutine and function form; however, only one form can be used in any given program unit.
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL RENAME(SRC, DST[, STATUS])`
+- **Arguments:**
+- **Return value** status code (0: success, non-zero for errors)
+
+| Argument | Description |
+|----------|-----------------------------------|
+| `SRC` | Source path |
+| `DST` | Destination path |
+| `STATUS` | Status code (for subroutine form) |
+
+The status code returned by both the subroutine and function form corresponds to the value of `errno` if the invocation of `rename(2)` was not successful.
+
+#### Example
+
+Function form:
+```
+program rename_func
+ implicit none
+ integer :: status
+ status = rename('src', 'dst')
+ print *, 'status:', status
+ status = rename('dst', 'src')
+ print *, 'status:', status
+end program rename_func
+```
+
+Subroutine form:
+```
+program rename_proc
+ implicit none
+ integer :: status
+ call rename('src', 'dst', status)
+ print *, 'status:', status
+ call rename('dst', 'src')
+end program rename_proc
+```
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 53168a920e3c6..a5f701bee5120 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -347,6 +347,8 @@ struct IntrinsicLibrary {
fir::ExtendedValue genReduce(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genReduceDim(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genRename(std::optional<mlir::Type>,
+ mlir::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genRRSpacing(mlir::Type resultType,
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index 7497a4bc35646..240de5a899d37 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -53,6 +53,10 @@ void genRandomNumber(fir::FirOpBuilder &, mlir::Location, mlir::Value harvest);
void genRandomSeed(fir::FirOpBuilder &, mlir::Location, mlir::Value size,
mlir::Value put, mlir::Value get);
+/// generate rename runtime call
+void genRename(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value path1, mlir::Value path2, mlir::Value status);
+
/// generate runtime call to transfer intrinsic with no size argument
void genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value resultBox, mlir::Value sourceBox,
diff --git a/flang/include/flang/Runtime/misc-intrinsic.h b/flang/include/flang/Runtime/misc-intrinsic.h
index 73cc9e2023d97..3fb3aaed49c0f 100644
--- a/flang/include/flang/Runtime/misc-intrinsic.h
+++ b/flang/include/flang/Runtime/misc-intrinsic.h
@@ -19,6 +19,8 @@ namespace Fortran::runtime {
class Descriptor;
extern "C" {
+void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
+ const Descriptor *status, const char *sourceFile, int line);
void RTDECL(Transfer)(Descriptor &result, const Descriptor &source,
const Descriptor &mold, const char *sourceFile, int line);
void RTDECL(TransferSize)(Descriptor &result, const Descriptor &source,
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index de6e79783a313..e8f3c5f1161af 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -795,6 +795,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"identity", SameType, Rank::scalar, Optionality::optional},
{"ordered", AnyLogical, Rank::scalar, Optionality::optional}},
SameType, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"rename",
+ {{"path1", DefaultChar, Rank::scalar},
+ {"path2", DefaultChar, Rank::scalar}},
+ DefaultInt, Rank::scalar},
{"repeat",
{{"string", SameCharNoLen, Rank::scalar},
{"ncopies", AnyInt, Rank::scalar}},
@@ -1464,6 +1468,12 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"get", DefaultInt, Rank::vector, Optionality::optional,
common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"rename",
+ {{"path1", DefaultChar, Rank::scalar},
+ {"path2", DefaultChar, Rank::scalar},
+ {"status", DefaultInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out}},
+ {}, Rank::scalar, IntrinsicClass::impureSubroutine},
{"system",
{{"command", DefaultChar, Rank::scalar},
{"exitstat", DefaultInt, Rank::scalar, Optionality::optional,
@@ -2612,7 +2622,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[]{{"etime"}, {"getcwd"}};
+ static const std::string dualIntrinsic[]{
+ {"etime"s}, {"getcwd"s}, {"rename"s}};
return std::find_if(std::begin(dualIntrinsic), std::end(dualIntrinsic),
[&name](const std::string &dualName) {
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index fe7605d8ce4ba..6f49f46a7bf54 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -550,6 +550,12 @@ static constexpr IntrinsicHandler handlers[]{
{"identity", asAddr, handleDynamicOptional},
{"ordered", asValue, handleDynamicOptional}}},
/*isElemental=*/false},
+ {"rename",
+ &I::genRename,
+ {{{"path1", asBox},
+ {"path2", asBox},
+ {"status", asBox, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"repeat",
&I::genRepeat,
{{{"string", asAddr}, {"ncopies", asValue}}},
@@ -5917,6 +5923,37 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");
}
+// RENAME
+fir::ExtendedValue
+IntrinsicLibrary::genRename(std::optional<mlir::Type> resultType,
+ mlir::ArrayRef<fir::ExtendedValue> args) {
+ assert((args.size() == 3 && !resultType.has_value()) ||
+ (args.size() == 2 && resultType.has_value()));
+
+ mlir::Value path1 = fir::getBase(args[0]);
+ mlir::Value path2 = fir::getBase(args[1]);
+ if (!path1 || !path2)
+ fir::emitFatalError(loc, "Expected at least two dummy arguments");
+
+ if (resultType.has_value()) {
+ // code-gen for the function form of RENAME
+ auto statusAddr = builder.createTemporary(loc, *resultType);
+ auto statusBox = builder.createBox(loc, statusAddr);
+ fir::runtime::genRename(builder, loc, path1, path2, statusBox);
+ return builder.create<fir::LoadOp>(loc, statusAddr);
+ } else {
+ // code-gen for the procedure form of RENAME
+ mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+ auto status = args[2];
+ mlir::Value statusBox =
+ isStaticallyPresent(status)
+ ? fir::getBase(status)
+ : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+ fir::runtime::genRename(builder, loc, path1, path2, statusBox);
+ return {};
+ }
+}
+
// REPEAT
fir::ExtendedValue
IntrinsicLibrary::genRepeat(mlir::Type resultType,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 3f36d639861b1..aff3cadc3c300 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -199,6 +199,24 @@ void fir::runtime::genRandomSeed(fir::FirOpBuilder &builder, mlir::Location loc,
builder.create<fir::CallOp>(loc, func, args);
}
+/// generate rename runtime call
+void fir::runtime::genRename(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value path1, mlir::Value path2,
+ mlir::Value status) {
+ auto runtimeFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(Rename)>(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(4));
+
+ llvm::SmallVector<mlir::Value> args =
+ fir::runtime::createArguments(builder, loc, runtimeFuncTy, path1, path2,
+ status, sourceFile, sourceLine);
+ builder.create<fir::CallOp>(loc, runtimeFunc, args);
+}
+
/// generate runtime call to transfer intrinsic with no size argument
void fir::runtime::genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value resultBox, mlir::Value sourceBox,
diff --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index f5b292a1f3d32..2f7fcd2e2341f 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -12,6 +12,7 @@
#include "flang/Common/optional.h"
#include "flang/Runtime/descriptor.h"
#include <algorithm>
+#include <cstdio>
#include <cstring>
namespace Fortran::runtime {
@@ -55,6 +56,36 @@ static RT_API_ATTRS void TransferImpl(Descriptor &result,
extern "C" {
RT_EXT_API_GROUP_BEGIN
+void RTDECL(Rename)(const Descriptor &path1, const Descriptor &path2,
+ const Descriptor *status, const char *sourceFile, int line) {
+ Terminator terminator{sourceFile, line};
+
+ char *pathSrc{EnsureNullTerminated(
+ path1.OffsetElement(), path1.ElementBytes(), terminator)};
+ char *pathDst{EnsureNullTerminated(
+ path2.OffsetElement(), path2.ElementBytes(), terminator)};
+
+ // We simply call rename(2) from POSIX
+ int result{rename(pathSrc, pathDst)};
+ if (status) {
+ // When an error has happened,
+ int errorCode{0}; // Assume success
+ if (result != 0) {
+ // The rename operation has failed, so return the error code as status.
+ errorCode = errno;
+ }
+ StoreIntToDescriptor(status, errorCode, terminator);
+ }
+
+ // Deallocate memory if EnsureNullTerminated dynamically allocated memory
+ if (pathSrc != path1.OffsetElement()) {
+ FreeMemory(pathSrc);
+ }
+ if (pathDst != path2.OffsetElement()) {
+ FreeMemory(pathDst);
+ }
+}
+
void RTDEF(Transfer)(Descriptor &result, const Descriptor &source,
const Descriptor &mold, const char *sourceFile, int line) {
Fortran::common::optional<std::int64_t> elements;
diff --git a/flang/test/Lower/Intrinsics/rename.f90 b/flang/test/Lower/Intrinsics/rename.f90
new file mode 100644
index 0000000000000..75042217c6202
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/rename.f90
@@ -0,0 +1,51 @@
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK-LABEL: func.func @_QPtest_rename
+!CHECK-SAME: %[[dummySrc:.*]]: !fir.boxchar<1> {fir.bindc_name = "src"},
+!CHECK-SAME: %[[dummyDst:.*]]: !fir.boxchar<1> {fir.bindc_name = "dst"}) {
+subroutine test_rename(src, dst)
+ implicit none
+ character(*) :: src, dst
+
+ call rename(src, dst)
+ !CHECK: %[[dstUnbox:.*]]:2 = fir.unboxchar %[[dummyDst]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ !CHECK-NEXT: %[[dstDecl:.*]]:2 = hlfir.declare %[[dstUnbox]]#0 typeparams %[[dstUnbox]]#1 dummy_scope %0 {uniq_name = "_QFtest_renameEdst"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+ !CHECK-NEXT: %[[srcUnbox:.*]]:2 = fir.unboxchar %[[dummySrc]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ !CHECK-NEXT: %[[srcDecl:.*]]:2 = hlfir.declare %3#0 typeparams %[[srcUnbox]]#1 dummy_scope %0 {uniq_name = "_QFtest_renameEsrc"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+ !CHECK-NEXT: %[[srcBox:.*]] = fir.embox %[[srcDecl]]#1 typeparams %[[srcUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+ !CHECK-NEXT: %[[dstBox:.*]] = fir.embox %[[dstDecl]]#1 typeparams %[[dstUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+ !CHECK-NEXT: %[[statusBox:.*]] = fir.absent !fir.box<none>
+ !CHECK-NEXT: %[[sourceFile:.*]] = fir.address_of(@[[someString:.*]]) : !fir.ref<!fir.char<1,[[len:.*]]>>
+ !CHECK-NEXT: %[[c10_i32:.*]] = arith.constant [[line:.*]] : i32
+ !CHECK-NEXT: %[[src:.*]] = fir.convert %[[srcBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+ !CHECK-NEXT: %[[dst:.*]] = fir.convert %[[dstBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+ !CHECK-NEXT: %[[loc:.*]] = fir.convert %[[sourceFileConv:.*]]: (!fir.ref<!fir.char<1,[[len:.*]]>>) -> !fir.ref<i8>
+ !CHECK-NEXT: %[[result:.*]] = fir.call @_FortranARename(%[[src]], %[[dst]], %[[statusBox]], %[[loc]], %[[c10_i32]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+end subroutine test_rename
+
+!CHECK-LABEL: func.func @_QPtest_rename_status
+!CHECK-SAME: %[[dummySrc:.*]]: !fir.boxchar<1> {fir.bindc_name = "src"},
+!CHECK-SAME: %[[dummyDst:.*]]: !fir.boxchar<1> {fir.bindc_name = "dst"}) {
+subroutine test_rename_status(src, dst)
+ implicit none
+ character(*) :: src, dst
+ integer :: status
+
+ call rename(src, dst, status)
+ !CHECK: %[[dstUnbox:.*]]:2 = fir.unboxchar %[[dummyDst]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ !CHECK-NEXT: %[[dstDecl:.*]]:2 = hlfir.declare %[[dstUnbox]]#0 typeparams %[[dstUnbox]]#1 dummy_scope %0 {uniq_name = "_QFtest_rename_statusEdst"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+ !CHECK-NEXT: %[[srcUnbox:.*]]:2 = fir.unboxchar %[[dummySrc]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ !CHECK-NEXT: %[[srcDecl:.*]]:2 = hlfir.declare %3#0 typeparams %[[srcUnbox]]#1 dummy_scope %0 {uniq_name = "_QFtest_rename_statusEsrc"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+ !CHECK-NEXT: %[[statusAlloc:.*]] = fir.alloca i32 {bindc_name = "status", uniq_name = "_QFtest_rename_statusEstatus"}
+ !CHECK-NEXT: %[[statusDecl:.*]]:2 = hlfir.declare %[[statusAlloc]] {uniq_name = "_QFtest_rename_statusEstatus"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ !CHECK-NEXT: %[[srcBox:.*]] = fir.embox %[[srcDecl]]#1 typeparams %[[srcUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+ !CHECK-NEXT: %[[dstBox:.*]] = fir.embox %[[dstDecl]]#1 typeparams %[[dstUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+ !CHECK-NEXT: %[[statusBox:.*]] = fir.embox %[[statusDecl]]#1 : (!fir.ref<i32>) -> !fir.box<i32>
+ !CHECK-NEXT: %[[sourceFile:.*]] = fir.address_of(@[[someString:.*]]) : !fir.ref<!fir.char<1,[[len:.*]]>>
+ !CHECK-NEXT: %[[c10_i32:.*]] = arith.constant [[line:.*]] : i32
+ !CHECK-NEXT: %[[src:.*]] = fir.convert %[[srcBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+ !CHECK-NEXT: %[[dst:.*]] = fir.convert %[[dstBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+ !CHECK-NEXT: %[[status:.*]] = fir.convert %[[statusBox]] : (!fir.box<i32>) -> !fir.box<none>
+ !CHECK-NEXT: %[[loc:.*]] = fir.convert %[[sourceFileConv:.*]]: (!fir.ref<!fir.char<1,[[len:.*]]>>) -> !fir.ref<i8>
+ !CHECK-NEXT: %[[result:.*]] = fir.call @_FortranARename(%[[src]], %[[dst]], %[[status]], %[[loc]], %[[c10_i32]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+end subroutine test_rename_status
diff --git a/flang/test/Lower/namelist.f90 b/flang/test/Lower/namelist.f90
index 9fdd8a2c8f613..a96bbbfad0cd6 100644
--- a/flang/test/Lower/namelist.f90
+++ b/flang/test/Lower/namelist.f90
@@ -71,7 +71,7 @@ program p
! CHECK: %[[V_70:[0-9]+]] = fir.call @_FortranAioEndIoStatement(%[[V_58]]) fastmath<contract> : (!fir.ref<i8>) -> i32
write(*, nnn)
- call rename
+ call rename_sub
end
! CHECK-LABEL: c.func @_QPsss
@@ -128,8 +128,8 @@ module mmm
namelist /aaa/ rrr
end
-! CHECK-LABEL: c.func @_QPrename
-subroutine rename
+! CHECK-LABEL: c.func @_QPrename_sub
+subroutine rename_sub
use mmm, bbb => aaa
rrr = 3.
! CHECK: %[[V_4:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
More information about the flang-commits
mailing list