[flang-commits] [flang] [llvm] [flang] Add ETIME runtime and lowering intrinsics implementation (PR #90578)
jiajie zhang via flang-commits
flang-commits at lists.llvm.org
Tue May 14 02:10:21 PDT 2024
https://github.com/JumpMasterJJ updated https://github.com/llvm/llvm-project/pull/90578
>From fdd6d07425fe7af5deb231937f21ed0e720402f4 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Fri, 26 Apr 2024 20:34:01 +0800
Subject: [PATCH 01/13] added subroutine of etime
---
.../flang/Optimizer/Builder/IntrinsicCall.h | 1 +
.../Optimizer/Builder/Runtime/Intrinsics.h | 2 +
flang/include/flang/Runtime/time-intrinsic.h | 3 ++
flang/lib/Evaluate/intrinsics.cpp | 7 +++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 21 +++++++++
.../Optimizer/Builder/Runtime/Intrinsics.cpp | 14 ++++++
flang/runtime/time-intrinsic.cpp | 43 +++++++++++++++++++
flang/runtime/tools.h | 9 ++++
8 files changed, 100 insertions(+)
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 6927488517e63..5c385c04ac3e9 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -222,6 +222,7 @@ struct IntrinsicLibrary {
fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genExit(llvm::ArrayRef<fir::ExtendedValue>);
void genExecuteCommandLine(mlir::ArrayRef<fir::ExtendedValue> args);
+ void genEtime(mlir::ArrayRef<fir::ExtendedValue> args);
mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genExtendsTypeOf(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index 737c631e45c1f..7497a4bc35646 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -44,6 +44,8 @@ void genDateAndTime(fir::FirOpBuilder &, mlir::Location,
std::optional<fir::CharBoxValue> date,
std::optional<fir::CharBoxValue> time,
std::optional<fir::CharBoxValue> zone, mlir::Value values);
+void genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value values, mlir::Value time);
void genRandomInit(fir::FirOpBuilder &, mlir::Location, mlir::Value repeatable,
mlir::Value imageDistinct);
diff --git a/flang/include/flang/Runtime/time-intrinsic.h b/flang/include/flang/Runtime/time-intrinsic.h
index 650c02436ee49..80490a17e4559 100644
--- a/flang/include/flang/Runtime/time-intrinsic.h
+++ b/flang/include/flang/Runtime/time-intrinsic.h
@@ -43,6 +43,9 @@ void RTNAME(DateAndTime)(char *date, std::size_t dateChars, char *time,
const char *source = nullptr, int line = 0,
const Descriptor *values = nullptr);
+void RTNAME(Etime)(const Descriptor *values, const Descriptor *time,
+ const char *sourceFile, int line);
+
} // extern "C"
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_TIME_INTRINSIC_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index f07f94b1a022c..fd92ba12374dd 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1340,6 +1340,13 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"values", AnyInt, Rank::vector, Optionality::optional,
common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"etime",
+ {
+ {"values", DefaultReal, Rank::vector, Optionality::required, common::Intent::Out},
+ {"time", DefaultReal, Rank::scalar, Optionality::required, common::Intent::Out}
+ },
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine
+ },
{"execute_command_line",
{{"command", DefaultChar, Rank::scalar},
{"wait", AnyLogical, Rank::scalar, Optionality::optional},
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 4ee7258004fa7..f0b0b7c74cf5a 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -222,6 +222,11 @@ static constexpr IntrinsicHandler handlers[]{
{"boundary", asBox, handleDynamicOptional},
{"dim", asValue}}},
/*isElemental=*/false},
+ {"etime",
+ &I::genEtime,
+ {{{"values", asBox},
+ {"time", asBox}}},
+ /*isElemental=*/false},
{"execute_command_line",
&I::genExecuteCommandLine,
{{{"command", asBox},
@@ -3230,6 +3235,22 @@ void IntrinsicLibrary::genExecuteCommandLine(
exitstatBox, cmdstatBox, cmdmsgBox);
}
+// ETIME
+void IntrinsicLibrary::genEtime(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 2);
+
+ mlir::Value values = fir::getBase(args[0]);
+ mlir::Value time = fir::getBase(args[1]);
+
+ if (!values)
+ fir::emitFatalError(loc, "expected VALUES parameter");
+ if (!time)
+ fir::emitFatalError(loc, "expected TIME parameter");
+
+ fir::runtime::genEtime(builder, loc, values, time);
+}
+
// EXIT
void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 1);
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 57c47da0f3f85..f1e62484e6502 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -106,6 +106,20 @@ void fir::runtime::genDateAndTime(fir::FirOpBuilder &builder,
builder.create<fir::CallOp>(loc, callee, args);
}
+void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value values, mlir::Value time) {
+ auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Etime)>(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(3));
+
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, runtimeFuncTy, values, time, sourceFile, sourceLine);
+ builder.create<fir::CallOp>(loc, runtimeFunc, args);
+}
+
void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value repeatable,
mlir::Value imageDistinct) {
diff --git a/flang/runtime/time-intrinsic.cpp b/flang/runtime/time-intrinsic.cpp
index 68d63253139f1..37ef35e15ca0b 100644
--- a/flang/runtime/time-intrinsic.cpp
+++ b/flang/runtime/time-intrinsic.cpp
@@ -19,6 +19,8 @@
#include <cstdlib>
#include <cstring>
#include <ctime>
+#include <sys/times.h>
+#include <unistd.h>
#ifndef _WIN32
#include <sys/time.h> // gettimeofday
#endif
@@ -370,5 +372,46 @@ void RTNAME(DateAndTime)(char *date, std::size_t dateChars, char *time,
terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
}
+void RTNAME(Etime)(const Descriptor *values, const Descriptor *time,
+ const char *sourceFile, int line) {
+ Fortran::runtime::Terminator terminator{sourceFile, line};
+
+ struct tms tms;
+ times(&tms);
+ auto usrTime = (double)(tms.tms_utime) / sysconf(_SC_CLK_TCK);
+ auto sysTime = (double)(tms.tms_stime) / sysconf(_SC_CLK_TCK);
+ auto realTime = usrTime + sysTime;
+
+ if (values) {
+ auto typeCode{values->type().GetCategoryAndKind()};
+ // ETIME values argument must have decimal range == 2.
+ RUNTIME_CHECK(terminator,
+ values->rank() == 1 && values->GetDimension(0).Extent() == 2 &&
+ typeCode && typeCode->first == Fortran::common::TypeCategory::Real);
+ // Only accept KIND=4 here.
+ int kind{typeCode->second};
+ RUNTIME_CHECK(terminator, kind == 4);
+
+ ApplyFloatingPointKind<StoreFloatingPointAt, void>(
+ kind, terminator, *values, /* atIndex = */ 0, usrTime);
+ ApplyFloatingPointKind<StoreFloatingPointAt, void>(
+ kind, terminator, *values, /* atIndex = */ 1, sysTime);
+ }
+
+ if (time) {
+ auto typeCode{time->type().GetCategoryAndKind()};
+ // ETIME time argument must have decimal range == 0.
+ RUNTIME_CHECK(terminator,
+ time->rank() == 0 && typeCode &&
+ typeCode->first == Fortran::common::TypeCategory::Real);
+ // Only accept KIND=4 here.
+ int kind{typeCode->second};
+ RUNTIME_CHECK(terminator, kind == 4);
+
+ ApplyFloatingPointKind<StoreFloatingPointAt, void>(
+ kind, terminator, *time, /* atIndex = */ 0, realTime);
+ }
+}
+
} // extern "C"
} // namespace Fortran::runtime
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index 52049c511f13e..dc12e5c4533e2 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -99,6 +99,15 @@ template <int KIND> struct StoreIntegerAt {
}
};
+// Helper to store floating value in result[at].
+template <int KIND> struct StoreFloatingPointAt {
+ RT_API_ATTRS void operator()(const Fortran::runtime::Descriptor &result,
+ std::size_t at, std::double_t value) const {
+ *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
+ Fortran::common::TypeCategory::Real, KIND>>(at) = value;
+ }
+};
+
// Validate a KIND= argument
RT_API_ATTRS void CheckIntegerKind(
Terminator &, int kind, const char *intrinsic);
>From cb502157fe080f46c517b4865e315bd59f657946 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 29 Apr 2024 17:33:32 +0800
Subject: [PATCH 02/13] fixed type patterm of etime's arguments
---
flang/lib/Evaluate/intrinsics.cpp | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index fd92ba12374dd..5077b1c64e825 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1342,8 +1342,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"etime",
{
- {"values", DefaultReal, Rank::vector, Optionality::required, common::Intent::Out},
- {"time", DefaultReal, Rank::scalar, Optionality::required, common::Intent::Out}
+ {"values", TypePattern{RealType, KindCode::exactKind, 4}, Rank::vector, Optionality::required, common::Intent::Out},
+ {"time", TypePattern{RealType, KindCode::exactKind, 4}, Rank::scalar, Optionality::required, common::Intent::Out}
},
{}, Rank::elemental, IntrinsicClass::impureSubroutine
},
>From 371fade48ad313ab91dd72b0536c96e2d5a37791 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 29 Apr 2024 17:34:13 +0800
Subject: [PATCH 03/13] added doc about etime
---
flang/docs/Intrinsics.md | 51 ++++++++++++++++++++++++++++++++++++++++
1 file changed, 51 insertions(+)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 848619cb65d90..46889bd141522 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -916,3 +916,54 @@ used in constant expressions have currently no folding support at all.
- If a condition occurs that would assign a nonzero value to `CMDSTAT` but the `CMDSTAT` variable is not present, error termination is initiated.
- On POSIX-compatible systems, the child process (async process) will be terminated with no effect on the parent process (continues).
- On Windows, error termination is not initiated.
+
+### Non-Standard Intrinsics: ETIME
+
+#### Description
+`ETIME(VALUES, TIME)` returns the number of seconds of runtime since the start of the process’s execution in *TIME*. *VALUES* returns the user and system components of this time in `VALUES(1)` and `VALUES(2)` respectively. *TIME* is equal to `VALUES(1) + VALUES(2)`.
+
+On some systems, the underlying timings are represented using types with sufficiently small limits that overflows (wrap around) are possible, such as 32-bit types. Therefore, the values returned by this intrinsic might be, or become, negative, or numerically less than previous values, during a single run of the compiled program.
+
+This intrinsic is provided in subroutine forms only.
+
+*VALUES* and *TIME* are `INTENT(OUT)` and provide the following:
+
+
+| | |
+|---------------|-----------------------------------|
+| `VALUES(1)` | User time in seconds. |
+| `VALUES(2)` | System time in seconds. |
+| `TIME` | Run time since start in seconds. |
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine
+- **Syntax:** `CALL ETIME(VALUES, TIME)`
+- **Arguments:**
+
+| Argument | Description |
+|------------|-----------------------------------------------------------------------|
+| `VALUES` | The type shall be REAL(4), DIMENSION(2). |
+| `TIME` | The type shall be REAL(4). |
+
+#### Example
+
+```Fortran
+program test_etime
+ integer(8) :: i, j
+ real, dimension(2) :: tarray
+ real :: result
+ call ETIME(tarray, result)
+ print *, result
+ print *, tarray(1)
+ print *, tarray(2)
+ do i=1,100000000 ! Just a delay
+ j = i * i - i
+ end do
+ call ETIME(tarray, result)
+ print *, result
+ print *, tarray(1)
+ print *, tarray(2)
+end program test_etime
+```
\ No newline at end of file
>From 301e6385f8df03bf0aaf1b480971b86e98b14898 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 29 Apr 2024 22:08:11 +0800
Subject: [PATCH 04/13] added tests of etime
---
flang/test/Lower/Intrinsics/etime.f90 | 21 +++++++++++++++++++++
flang/test/Semantics/etime.f90 | 21 +++++++++++++++++++++
2 files changed, 42 insertions(+)
create mode 100644 flang/test/Lower/Intrinsics/etime.f90
create mode 100644 flang/test/Semantics/etime.f90
diff --git a/flang/test/Lower/Intrinsics/etime.f90 b/flang/test/Lower/Intrinsics/etime.f90
new file mode 100644
index 0000000000000..e5e7984a340ca
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/etime.f90
@@ -0,0 +1,21 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPetime_test(
+! CHECK-SAME: %[[valuesArg:.*]]: !fir.ref<!fir.array<2xf32>> {fir.bindc_name = "values"},
+! CHECK-SAME: %[[timeArg:.*]]: !fir.ref<f32> {fir.bindc_name = "time"}) {
+subroutine etime_test(values, time)
+ REAL(4), DIMENSION(2) :: values
+ REAL(4) :: time
+ call etime(values, time)
+ ! CHECK-NEXT: %[[c9:.*]] = arith.constant 9 : i32
+ ! CHECK-NEXT: %[[c2:.*]] = arith.constant 2 : index
+ ! CHECK-NEXT: %[[timeDeclare:.*]] = fir.declare %[[timeArg]] {uniq_name = "_QFetime_testEtime"} : (!fir.ref<f32>) -> !fir.ref<f32>
+ ! CHECK-NEXT: %[[shape:.*]] = fir.shape %[[c2]] : (index) -> !fir.shape<1>
+ ! CHECK-NEXT: %[[valuesDeclare:.*]] = fir.declare %[[valuesArg]](%[[shape]]) {uniq_name = "_QFetime_testEvalues"} : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.ref<!fir.array<2xf32>>
+ ! CHECK-NEXT: %[[valuesBox:.*]] = fir.embox %[[valuesDeclare]](%[[shape]]) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xf32>>
+ ! CHECK-NEXT: %[[timeBox:.*]] = fir.embox %[[timeDeclare]] : (!fir.ref<f32>) -> !fir.box<f32>
+ ! CHECK: %[[values:.*]] = fir.convert %[[valuesBox]] : (!fir.box<!fir.array<2xf32>>) -> !fir.box<none>
+ ! CHECK: %[[time:.*]] = fir.convert %[[timeBox]] : (!fir.box<f32>) -> !fir.box<none>
+ ! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAEtime(%[[values]], %[[time]], %[[VAL_7:.*]], %[[c9]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+ ! CHECK-NEXT: return
+end subroutine etime_test
\ No newline at end of file
diff --git a/flang/test/Semantics/etime.f90 b/flang/test/Semantics/etime.f90
new file mode 100644
index 0000000000000..176b63b2a576d
--- /dev/null
+++ b/flang/test/Semantics/etime.f90
@@ -0,0 +1,21 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Tests for the ETIME intrinsics
+
+subroutine bad_kind_error(values, time)
+ REAL(KIND=8), DIMENSION(2) :: values
+ REAL(KIND=8) :: time
+ !ERROR: Actual argument for 'values=' has bad type or kind 'REAL(8)'
+ call etime(values, time)
+end subroutine bad_kind_error
+
+subroutine bad_args_error(values)
+ REAL(KIND=4), DIMENSION(2) :: values
+ !ERROR: missing mandatory 'time=' argument
+ call etime(values)
+end subroutine bad_args_error
+
+subroutine good_kind_equal(values, time)
+ REAL(KIND=4), DIMENSION(2) :: values
+ REAL(KIND=4) :: time
+ call etime(values, time)
+end subroutine good_kind_equal
\ No newline at end of file
>From 1b5899300e1d5ffac659854322f0a445e62ee39a Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Tue, 30 Apr 2024 11:54:58 +0800
Subject: [PATCH 05/13] format source code
---
flang/lib/Evaluate/intrinsics.cpp | 18 +++++++++---------
1 file changed, 9 insertions(+), 9 deletions(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 5077b1c64e825..b77df3df75625 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1341,12 +1341,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{
common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"etime",
- {
- {"values", TypePattern{RealType, KindCode::exactKind, 4}, Rank::vector, Optionality::required, common::Intent::Out},
- {"time", TypePattern{RealType, KindCode::exactKind, 4}, Rank::scalar, Optionality::required, common::Intent::Out}
- },
- {}, Rank::elemental, IntrinsicClass::impureSubroutine
- },
+ {{"values", TypePattern{RealType, KindCode::exactKind, 4}, Rank::vector,
+ Optionality::required, common::Intent::Out},
+ {"time", TypePattern{RealType, KindCode::exactKind, 4},
+ Rank::scalar, Optionality::required, common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"execute_command_line",
{{"command", DefaultChar, Rank::scalar},
{"wait", AnyLogical, Rank::scalar, Optionality::optional},
@@ -1946,7 +1945,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
int elementalRank{0};
for (std::size_t j{0}; j < dummies; ++j) {
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
- if (const ActualArgument *arg{actualForDummy[j]}) {
+ if (const ActualArgument * arg{actualForDummy[j]}) {
bool isAssumedRank{IsAssumedRank(*arg)};
if (isAssumedRank && d.rank != Rank::anyOrAssumedRank &&
d.rank != Rank::arrayOrAssumedRank) {
@@ -2284,7 +2283,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case Rank::locReduced:
case Rank::scalarIfDim:
if (dummy[*dimArg].optionality == Optionality::required) {
- if (const Symbol *whole{
+ if (const Symbol *
+ whole{
UnwrapWholeSymbolOrComponentDataRef(actualForDummy[*dimArg])}) {
if (IsOptional(*whole) || IsAllocatableOrObjectPointer(whole)) {
if (context.languageFeatures().ShouldWarn(
@@ -2362,7 +2362,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
// Rearrange the actual arguments into dummy argument order.
ActualArguments rearranged(dummies);
for (std::size_t j{0}; j < dummies; ++j) {
- if (ActualArgument *arg{actualForDummy[j]}) {
+ if (ActualArgument * arg{actualForDummy[j]}) {
rearranged[j] = std::move(*arg);
}
}
>From 10747a9f0c4dbb2f768acaa0563160decdb1025c Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Tue, 30 Apr 2024 17:36:15 +0800
Subject: [PATCH 06/13] add windows support
---
flang/runtime/time-intrinsic.cpp | 37 ++++++++++++++++++++++++++------
1 file changed, 31 insertions(+), 6 deletions(-)
diff --git a/flang/runtime/time-intrinsic.cpp b/flang/runtime/time-intrinsic.cpp
index 37ef35e15ca0b..93b782693c4cc 100644
--- a/flang/runtime/time-intrinsic.cpp
+++ b/flang/runtime/time-intrinsic.cpp
@@ -19,10 +19,12 @@
#include <cstdlib>
#include <cstring>
#include <ctime>
+#ifdef _WIN32
+#include "flang/Common/windows-include.h"
+#else
+#include <sys/time.h> // gettimeofday
#include <sys/times.h>
#include <unistd.h>
-#ifndef _WIN32
-#include <sys/time.h> // gettimeofday
#endif
// CPU_TIME (Fortran 2018 16.9.57)
@@ -376,11 +378,34 @@ void RTNAME(Etime)(const Descriptor *values, const Descriptor *time,
const char *sourceFile, int line) {
Fortran::runtime::Terminator terminator{sourceFile, line};
+ double usrTime = -1.0, sysTime = -1.0, realTime = -1.0;
+
+#ifdef _WIN32
+ FILETIME creationTime;
+ FILETIME exitTime;
+ FILETIME kernelTime;
+ FILETIME userTime;
+
+ if (GetProcessTimes(GetCurrentProcess(), &creationTime, &exitTime,
+ &kernelTime, &userTime) != -1) {
+ ULARGE_INTEGER userSystemTime;
+ ULARGE_INTEGER kernelSystemTime;
+
+ memcpy(&userSystemTime, &userTime, sizeof(FILETIME));
+ memcpy(&kernelSystemTime, &kernelTime, sizeof(FILETIME));
+
+ usrTime = double(userSystemTime.QuadPart / 10000);
+ sysTime = double(kernelSystemTime.QuadPart / 10000);
+ realTime = usrTime + sysTime;
+ }
+#else
struct tms tms;
- times(&tms);
- auto usrTime = (double)(tms.tms_utime) / sysconf(_SC_CLK_TCK);
- auto sysTime = (double)(tms.tms_stime) / sysconf(_SC_CLK_TCK);
- auto realTime = usrTime + sysTime;
+ if (times(&tms) != -1) {
+ usrTime = (double)(tms.tms_utime) / sysconf(_SC_CLK_TCK);
+ sysTime = (double)(tms.tms_stime) / sysconf(_SC_CLK_TCK);
+ realTime = usrTime + sysTime;
+ }
+#endif
if (values) {
auto typeCode{values->type().GetCategoryAndKind()};
>From cb557da49af977b300954776cd54e740a6f0d1a2 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Wed, 1 May 2024 20:00:00 +0800
Subject: [PATCH 07/13] format source code
---
flang/lib/Evaluate/intrinsics.cpp | 7 +++----
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 6 ++----
2 files changed, 5 insertions(+), 8 deletions(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index b77df3df75625..00e3483905243 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1945,7 +1945,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
int elementalRank{0};
for (std::size_t j{0}; j < dummies; ++j) {
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
- if (const ActualArgument * arg{actualForDummy[j]}) {
+ if (const ActualArgument *arg{actualForDummy[j]}) {
bool isAssumedRank{IsAssumedRank(*arg)};
if (isAssumedRank && d.rank != Rank::anyOrAssumedRank &&
d.rank != Rank::arrayOrAssumedRank) {
@@ -2283,8 +2283,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case Rank::locReduced:
case Rank::scalarIfDim:
if (dummy[*dimArg].optionality == Optionality::required) {
- if (const Symbol *
- whole{
+ if (const Symbol *whole{
UnwrapWholeSymbolOrComponentDataRef(actualForDummy[*dimArg])}) {
if (IsOptional(*whole) || IsAllocatableOrObjectPointer(whole)) {
if (context.languageFeatures().ShouldWarn(
@@ -2362,7 +2361,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
// Rearrange the actual arguments into dummy argument order.
ActualArguments rearranged(dummies);
for (std::size_t j{0}; j < dummies; ++j) {
- if (ActualArgument * arg{actualForDummy[j]}) {
+ if (ActualArgument *arg{actualForDummy[j]}) {
rearranged[j] = std::move(*arg);
}
}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index f0b0b7c74cf5a..26364961f0e5c 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -224,8 +224,7 @@ static constexpr IntrinsicHandler handlers[]{
/*isElemental=*/false},
{"etime",
&I::genEtime,
- {{{"values", asBox},
- {"time", asBox}}},
+ {{{"values", asBox}, {"time", asBox}}},
/*isElemental=*/false},
{"execute_command_line",
&I::genExecuteCommandLine,
@@ -3236,8 +3235,7 @@ void IntrinsicLibrary::genExecuteCommandLine(
}
// ETIME
-void IntrinsicLibrary::genEtime(
- llvm::ArrayRef<fir::ExtendedValue> args) {
+void IntrinsicLibrary::genEtime(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 2);
mlir::Value values = fir::getBase(args[0]);
>From ac3e306e051fd13a884763f2ce2cc249e890e3a7 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Wed, 1 May 2024 20:10:29 +0800
Subject: [PATCH 08/13] add reference of example
---
flang/docs/Intrinsics.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 46889bd141522..8bb10808cda48 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -948,7 +948,7 @@ This intrinsic is provided in subroutine forms only.
| `TIME` | The type shall be REAL(4). |
#### Example
-
+Here is an example usage from [Gfortran ETIME](https://gcc.gnu.org/onlinedocs/gfortran/ETIME.html)
```Fortran
program test_etime
integer(8) :: i, j
>From 2356ea821b3731963ef9ed6f8739a92c604dbed9 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Wed, 1 May 2024 23:54:55 +0800
Subject: [PATCH 09/13] fix integer division on Windows
---
flang/runtime/time-intrinsic.cpp | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/flang/runtime/time-intrinsic.cpp b/flang/runtime/time-intrinsic.cpp
index 93b782693c4cc..989d4f804c5f7 100644
--- a/flang/runtime/time-intrinsic.cpp
+++ b/flang/runtime/time-intrinsic.cpp
@@ -387,22 +387,22 @@ void RTNAME(Etime)(const Descriptor *values, const Descriptor *time,
FILETIME userTime;
if (GetProcessTimes(GetCurrentProcess(), &creationTime, &exitTime,
- &kernelTime, &userTime) != -1) {
+ &kernelTime, &userTime) == 0) {
ULARGE_INTEGER userSystemTime;
ULARGE_INTEGER kernelSystemTime;
memcpy(&userSystemTime, &userTime, sizeof(FILETIME));
memcpy(&kernelSystemTime, &kernelTime, sizeof(FILETIME));
- usrTime = double(userSystemTime.QuadPart / 10000);
- sysTime = double(kernelSystemTime.QuadPart / 10000);
+ usrTime = ((double)(userSystemTime.QuadPart)) / 10000000.0;
+ sysTime = ((double)(kernelSystemTime.QuadPart)) / 10000000.0;
realTime = usrTime + sysTime;
}
#else
struct tms tms;
if (times(&tms) != -1) {
- usrTime = (double)(tms.tms_utime) / sysconf(_SC_CLK_TCK);
- sysTime = (double)(tms.tms_stime) / sysconf(_SC_CLK_TCK);
+ usrTime = ((double)(tms.tms_utime)) / sysconf(_SC_CLK_TCK);
+ sysTime = ((double)(tms.tms_stime)) / sysconf(_SC_CLK_TCK);
realTime = usrTime + sysTime;
}
#endif
>From 3748c055efdb175cd2956d94bb55b8324480cb96 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Sun, 12 May 2024 19:07:38 +0800
Subject: [PATCH 10/13] add support function form of etime
---
.../flang/Optimizer/Builder/IntrinsicCall.h | 13 ++-
flang/lib/Evaluate/intrinsics.cpp | 22 +++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 100 ++++++++++++++++--
3 files changed, 120 insertions(+), 15 deletions(-)
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 5c385c04ac3e9..89f987a2522d4 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -222,7 +222,8 @@ struct IntrinsicLibrary {
fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genExit(llvm::ArrayRef<fir::ExtendedValue>);
void genExecuteCommandLine(mlir::ArrayRef<fir::ExtendedValue> args);
- void genEtime(mlir::ArrayRef<fir::ExtendedValue> args);
+ fir::ExtendedValue genEtime(std::optional<mlir::Type>,
+ mlir::ArrayRef<fir::ExtendedValue> args);
mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genExtendsTypeOf(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
@@ -399,8 +400,10 @@ struct IntrinsicLibrary {
using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim);
using SubroutineGenerator = decltype(&IntrinsicLibrary::genDateAndTime);
- using Generator =
- std::variant<ElementalGenerator, ExtendedGenerator, SubroutineGenerator>;
+ /// The generator for intrinsic that has both function and subroutine form.
+ using DualGenerator = decltype(&IntrinsicLibrary::genEtime);
+ using Generator = std::variant<ElementalGenerator, ExtendedGenerator,
+ SubroutineGenerator, DualGenerator>;
/// All generators can be outlined. This will build a function named
/// "fir."+ <generic name> + "." + <result type code> and generate the
@@ -441,6 +444,10 @@ struct IntrinsicLibrary {
llvm::ArrayRef<mlir::Value> args);
mlir::Value invokeGenerator(SubroutineGenerator generator,
llvm::ArrayRef<mlir::Value> args);
+ mlir::Value invokeGenerator(DualGenerator generator,
+ llvm::ArrayRef<mlir::Value> args);
+ mlir::Value invokeGenerator(DualGenerator generator, mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args);
/// Get pointer to unrestricted intrinsic. Generate the related unrestricted
/// intrinsic if it is not defined yet.
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 00e3483905243..7e235b276df45 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -454,6 +454,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"erf", {{"x", SameReal}}, SameReal},
{"erfc", {{"x", SameReal}}, SameReal},
{"erfc_scaled", {{"x", SameReal}}, SameReal},
+ {"etime",
+ {{"values", TypePattern{RealType, KindCode::exactKind, 4}, Rank::vector,
+ Optionality::required, common::Intent::Out}},
+ TypePattern{RealType, KindCode::exactKind, 4}},
{"exp", {{"x", SameFloating}}, SameFloating},
{"exp", {{"x", SameFloating}}, SameFloating},
{"exponent", {{"x", AnyReal}}, DefaultInt},
@@ -973,6 +977,12 @@ static const std::pair<const char *, const char *> genericAlias[]{
{"__builtin_ieee_selected_real_kind", "selected_real_kind"},
};
+// Collection for some intrinsics with function and subroutine form,
+// in order to pass
+static const std::string dualIntrinsic[]{
+ {"etime"}
+};
+
// The following table contains the intrinsic functions listed in
// Tables 16.2 and 16.3 in Fortran 2018. The "unrestricted" functions
// in Table 16.2 can be used as actual arguments, PROCEDURE() interfaces,
@@ -2488,6 +2498,7 @@ class IntrinsicProcTable::Implementation {
bool IsIntrinsic(const std::string &) const;
bool IsIntrinsicFunction(const std::string &) const;
bool IsIntrinsicSubroutine(const std::string &) const;
+ bool IsDualIntrinsic(const std::string &) const;
IntrinsicClass GetIntrinsicClass(const std::string &) const;
std::string GetGenericIntrinsicName(const std::string &) const;
@@ -2549,6 +2560,13 @@ bool IntrinsicProcTable::Implementation::IsIntrinsic(
const std::string &name) const {
return IsIntrinsicFunction(name) || IsIntrinsicSubroutine(name);
}
+bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
+ const std::string &name) const {
+ return std::find_if(std::begin(dualIntrinsic), std::end(dualIntrinsic),
+ [&name](const std::string &dualName) {
+ return dualName == name;
+ }) != std::end(dualIntrinsic);
+}
IntrinsicClass IntrinsicProcTable::Implementation::GetIntrinsicClass(
const std::string &name) const {
@@ -3080,7 +3098,7 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
return specificCall;
}
}
- if (IsIntrinsicFunction(call.name)) {
+ if (IsIntrinsicFunction(call.name) && !IsDualIntrinsic(call.name)) {
context.messages().Say(
"Cannot use intrinsic function '%s' as a subroutine"_err_en_US,
call.name);
@@ -3215,7 +3233,7 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
}
if (specificBuffer.empty() && genericBuffer.empty() &&
- IsIntrinsicSubroutine(call.name)) {
+ IsIntrinsicSubroutine(call.name) && IsDualIntrinsic(call.name)) {
context.messages().Say(
"Cannot use intrinsic subroutine '%s' as a function"_err_en_US,
call.name);
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 26364961f0e5c..2a76d48de9afd 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -35,6 +35,7 @@
#include "flang/Optimizer/Builder/Runtime/Stop.h"
#include "flang/Optimizer/Builder/Runtime/Transformational.h"
#include "flang/Optimizer/Builder/Todo.h"
+#include "flang/Optimizer/Dialect/FIROps.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Optimizer/Dialect/Support/FIRContext.h"
#include "flang/Optimizer/Support/FatalError.h"
@@ -49,6 +50,7 @@
#include "llvm/Support/Debug.h"
#include "llvm/Support/MathExtras.h"
#include "llvm/Support/raw_ostream.h"
+#include <mlir/IR/Value.h>
#include <optional>
#define DEBUG_TYPE "flang-lower-intrinsic"
@@ -1681,6 +1683,24 @@ IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(
return mlir::Value();
}
+template <>
+fir::ExtendedValue
+IntrinsicLibrary::genElementalCall<IntrinsicLibrary::DualGenerator>(
+ DualGenerator generator, llvm::StringRef name, mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
+ assert(resultType.getImpl() && "expect elemental intrinsic to be functions");
+
+ for (const fir::ExtendedValue &arg : args)
+ if (!arg.getUnboxed() && !arg.getCharBox())
+ // fir::emitFatalError(loc, "nonscalar intrinsic argument");
+ crashOnMissingIntrinsic(loc, name);
+ if (outline)
+ return outlineInExtendedWrapper(generator, name, resultType, args);
+
+ return std::invoke(generator, *this, std::optional<mlir::Type>{resultType},
+ args);
+}
+
static fir::ExtendedValue
invokeHandler(IntrinsicLibrary::ElementalGenerator generator,
const IntrinsicHandler &handler,
@@ -1724,6 +1744,22 @@ invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
return mlir::Value{};
}
+static fir::ExtendedValue
+invokeHandler(IntrinsicLibrary::DualGenerator generator,
+ const IntrinsicHandler &handler,
+ std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
+ IntrinsicLibrary &lib) {
+ if (handler.isElemental)
+ return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,
+ outline);
+ if (outline)
+ return lib.outlineInExtendedWrapper(generator, handler.name, resultType,
+ args);
+
+ return std::invoke(generator, lib, resultType, args);
+}
+
std::pair<fir::ExtendedValue, bool>
IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
std::optional<mlir::Type> resultType,
@@ -1819,6 +1855,34 @@ IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
return {};
}
+mlir::Value
+IntrinsicLibrary::invokeGenerator(DualGenerator generator,
+ llvm::ArrayRef<mlir::Value> args) {
+ llvm::SmallVector<fir::ExtendedValue> extendedArgs;
+ for (mlir::Value arg : args)
+ extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
+ std::invoke(generator, *this, std::optional<mlir::Type>{}, extendedArgs);
+ return {};
+}
+
+mlir::Value
+IntrinsicLibrary::invokeGenerator(DualGenerator generator,
+ mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ llvm::SmallVector<fir::ExtendedValue> extendedArgs;
+ for (mlir::Value arg : args)
+ extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
+
+ if (resultType.getImpl() == nullptr) {
+ // TODO:
+ assert(false && "result type is null");
+ }
+
+ auto extendedResult = std::invoke(
+ generator, *this, std::optional<mlir::Type>{resultType}, extendedArgs);
+ return toValue(extendedResult, builder, loc);
+}
+
//===----------------------------------------------------------------------===//
// Intrinsic Procedure Mangling
//===----------------------------------------------------------------------===//
@@ -3235,18 +3299,34 @@ void IntrinsicLibrary::genExecuteCommandLine(
}
// ETIME
-void IntrinsicLibrary::genEtime(llvm::ArrayRef<fir::ExtendedValue> args) {
- assert(args.size() == 2);
+fir::ExtendedValue
+IntrinsicLibrary::genEtime(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 values = fir::getBase(args[0]);
- mlir::Value time = fir::getBase(args[1]);
-
- if (!values)
- fir::emitFatalError(loc, "expected VALUES parameter");
- if (!time)
- fir::emitFatalError(loc, "expected TIME parameter");
-
- fir::runtime::genEtime(builder, loc, values, time);
+ if (resultType.has_value()) {
+ // function form
+ if (!values)
+ fir::emitFatalError(loc, "expected VALUES parameter");
+
+ auto timeAddr = builder.createTemporary(loc, *resultType);
+ auto timeBox = builder.createBox(loc, timeAddr);
+ fir::runtime::genEtime(builder, loc, values, timeBox);
+ return builder.create<fir::LoadOp>(loc, timeAddr);
+ } else {
+ // subroutine form
+ mlir::Value time = fir::getBase(args[1]);
+ if (!values)
+ fir::emitFatalError(loc, "expected VALUES parameter");
+ if (!time)
+ fir::emitFatalError(loc, "expected TIME parameter");
+
+ fir::runtime::genEtime(builder, loc, values, time);
+ return {};
+ }
+ return {};
}
// EXIT
>From dce66785b241140a98feff1dfed1c732181294a3 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Sun, 12 May 2024 19:08:05 +0800
Subject: [PATCH 11/13] update docs about etime function
---
flang/docs/Intrinsics.md | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 8bb10808cda48..41129b10083b1 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -924,7 +924,7 @@ used in constant expressions have currently no folding support at all.
On some systems, the underlying timings are represented using types with sufficiently small limits that overflows (wrap around) are possible, such as 32-bit types. Therefore, the values returned by this intrinsic might be, or become, negative, or numerically less than previous values, during a single run of the compiled program.
-This intrinsic is provided in subroutine forms only.
+This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit.
*VALUES* and *TIME* are `INTENT(OUT)` and provide the following:
@@ -938,9 +938,10 @@ This intrinsic is provided in subroutine forms only.
#### Usage and Info
- **Standard:** GNU extension
-- **Class:** Subroutine
+- **Class:** Subroutine, function
- **Syntax:** `CALL ETIME(VALUES, TIME)`
- **Arguments:**
+- **Return value** Elapsed time in seconds since the start of program execution.
| Argument | Description |
|------------|-----------------------------------------------------------------------|
>From 4594ae6051cf597716a4ec75241edf0099a12235 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Sun, 12 May 2024 19:08:27 +0800
Subject: [PATCH 12/13] update tests about etime function
---
etime-function.mlir | 25 +++++++++++++++++++
.../test/Lower/Intrinsics/etime-function.f90 | 24 ++++++++++++++++++
flang/test/Semantics/etime.f90 | 9 +++++++
3 files changed, 58 insertions(+)
create mode 100644 etime-function.mlir
create mode 100644 flang/test/Lower/Intrinsics/etime-function.f90
diff --git a/etime-function.mlir b/etime-function.mlir
new file mode 100644
index 0000000000000..740dfd4866aa3
--- /dev/null
+++ b/etime-function.mlir
@@ -0,0 +1,25 @@
+module attributes {dlti.dl_spec = #dlti.dl_spec<#dlti.dl_entry<i32, dense<32> : vector<2xi64>>, #dlti.dl_entry<i8, dense<8> : vector<2xi64>>, #dlti.dl_entry<i16, dense<16> : vector<2xi64>>, #dlti.dl_entry<!llvm.ptr, dense<64> : vector<4xi64>>, #dlti.dl_entry<i1, dense<8> : vector<2xi64>>, #dlti.dl_entry<i64, dense<64> : vector<2xi64>>, #dlti.dl_entry<f80, dense<128> : vector<2xi64>>, #dlti.dl_entry<i128, dense<128> : vector<2xi64>>, #dlti.dl_entry<!llvm.ptr<270>, dense<32> : vector<4xi64>>, #dlti.dl_entry<f16, dense<16> : vector<2xi64>>, #dlti.dl_entry<!llvm.ptr<272>, dense<64> : vector<4xi64>>, #dlti.dl_entry<f64, dense<64> : vector<2xi64>>, #dlti.dl_entry<f128, dense<128> : vector<2xi64>>, #dlti.dl_entry<!llvm.ptr<271>, dense<32> : vector<4xi64>>, #dlti.dl_entry<"dlti.endianness", "little">, #dlti.dl_entry<"dlti.stack_alignment", 128 : i64>>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.target_triple = "x86_64-unknown-linux-gnu"} {
+ func.func @_QPetime_test(%arg0: !fir.ref<!fir.array<2xf32>> {fir.bindc_name = "values"}, %arg1: !fir.ref<f32> {fir.bindc_name = "time"}) {
+ %c9_i32 = arith.constant 9 : i32
+ %c2 = arith.constant 2 : index
+ %0 = fir.alloca f32
+ %1 = fir.declare %arg1 {uniq_name = "_QFetime_testEtime"} : (!fir.ref<f32>) -> !fir.ref<f32>
+ %2 = fir.shape %c2 : (index) -> !fir.shape<1>
+ %3 = fir.declare %arg0(%2) {uniq_name = "_QFetime_testEvalues"} : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.ref<!fir.array<2xf32>>
+ %4 = fir.embox %3(%2) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xf32>>
+ %5 = fir.embox %0 : (!fir.ref<f32>) -> !fir.box<f32>
+ %6 = fir.address_of(@_QQclX116781708dcf8f012d7ec1e40d743d97) : !fir.ref<!fir.char<1,71>>
+ %7 = fir.convert %4 : (!fir.box<!fir.array<2xf32>>) -> !fir.box<none>
+ %8 = fir.convert %5 : (!fir.box<f32>) -> !fir.box<none>
+ %9 = fir.convert %6 : (!fir.ref<!fir.char<1,71>>) -> !fir.ref<i8>
+ %10 = fir.call @_FortranAEtime(%7, %8, %9, %c9_i32) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+ %11 = fir.load %0 : !fir.ref<f32>
+ fir.store %11 to %1 : !fir.ref<f32>
+ return
+ }
+ func.func private @_FortranAEtime(!fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none attributes {fir.runtime}
+ fir.global linkonce @_QQclX116781708dcf8f012d7ec1e40d743d97 constant : !fir.char<1,71> {
+ %0 = fir.string_lit "/home/jump/llvm-project/flang/test/Lower/Intrinsics/etime-function.f90\00"(71) : !fir.char<1,71>
+ fir.has_value %0 : !fir.char<1,71>
+ }
+}
diff --git a/flang/test/Lower/Intrinsics/etime-function.f90 b/flang/test/Lower/Intrinsics/etime-function.f90
new file mode 100644
index 0000000000000..c47d509af5357
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/etime-function.f90
@@ -0,0 +1,24 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPetime_test(
+! CHECK-SAME: %[[valuesArg:.*]]: !fir.ref<!fir.array<2xf32>> {fir.bindc_name = "values"},
+! CHECK-SAME: %[[timeArg:.*]]: !fir.ref<f32> {fir.bindc_name = "time"}) {
+subroutine etime_test(values, time)
+ REAL(4), DIMENSION(2) :: values
+ REAL(4) :: time
+ time = etime(values)
+ ! CHECK-NEXT: %[[c9:.*]] = arith.constant 9 : i32
+ ! CHECK-NEXT: %[[c2:.*]] = arith.constant 2 : index
+ ! CHECK-NEXT: %[[timeTmpAddr:.*]] = fir.alloca f32
+ ! CHECK-NEXT: %[[timeDeclare:.*]] = fir.declare %[[timeArg]] {uniq_name = "_QFetime_testEtime"} : (!fir.ref<f32>) -> !fir.ref<f32>
+ ! CHECK-NEXT: %[[shape:.*]] = fir.shape %[[c2]] : (index) -> !fir.shape<1>
+ ! CHECK-NEXT: %[[valuesDeclare:.*]] = fir.declare %[[valuesArg]](%[[shape]]) {uniq_name = "_QFetime_testEvalues"} : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.ref<!fir.array<2xf32>>
+ ! CHECK-NEXT: %[[valuesBox:.*]] = fir.embox %[[valuesDeclare]](%[[shape]]) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xf32>>
+ ! CHECK-NEXT: %[[timeTmpBox:.*]] = fir.embox %[[timeTmpAddr]] : (!fir.ref<f32>) -> !fir.box<f32>
+ ! CHECK: %[[values:.*]] = fir.convert %[[valuesBox]] : (!fir.box<!fir.array<2xf32>>) -> !fir.box<none>
+ ! CHECK: %[[timeTmp:.*]] = fir.convert %[[timeTmpBox]] : (!fir.box<f32>) -> !fir.box<none>
+ ! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAEtime(%[[values]], %[[timeTmp]], %[[VAL_7:.*]], %[[c9]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+ ! CHECK-NEXT: %[[timeValue:.*]] = fir.load %[[timeTmpAddr]] : !fir.ref<f32>
+ ! CHECK-NEXT: fir.store %[[timeValue]] to %[[timeDeclare]] : !fir.ref<f32>
+ ! CHECK-NEXT: return
+end subroutine etime_test
\ No newline at end of file
diff --git a/flang/test/Semantics/etime.f90 b/flang/test/Semantics/etime.f90
index 176b63b2a576d..28735c2a7aacf 100644
--- a/flang/test/Semantics/etime.f90
+++ b/flang/test/Semantics/etime.f90
@@ -14,6 +14,15 @@ subroutine bad_args_error(values)
call etime(values)
end subroutine bad_args_error
+subroutine bad_apply_form(values)
+ REAL(KIND=4), DIMENSION(2) :: values
+ REAL(KIND=4) :: time
+ !Declaration of 'etime'
+ call etime(values, time)
+ !ERROR: Cannot call subroutine 'etime' like a function
+ time = etime(values)
+end subroutine bad_apply_form
+
subroutine good_kind_equal(values, time)
REAL(KIND=4), DIMENSION(2) :: values
REAL(KIND=4) :: time
>From 595f5d81b47e4f38949d64eb2d757faecb30a68b Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Tue, 14 May 2024 15:29:58 +0800
Subject: [PATCH 13/13] mv dual intrinsics table to local and fix the truncated
comment
---
flang/lib/Evaluate/intrinsics.cpp | 17 ++++++++---------
1 file changed, 8 insertions(+), 9 deletions(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 7e235b276df45..1dc13ec7a9df8 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -977,12 +977,6 @@ static const std::pair<const char *, const char *> genericAlias[]{
{"__builtin_ieee_selected_real_kind", "selected_real_kind"},
};
-// Collection for some intrinsics with function and subroutine form,
-// in order to pass
-static const std::string dualIntrinsic[]{
- {"etime"}
-};
-
// The following table contains the intrinsic functions listed in
// Tables 16.2 and 16.3 in Fortran 2018. The "unrestricted" functions
// in Table 16.2 can be used as actual arguments, PROCEDURE() interfaces,
@@ -1955,7 +1949,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
int elementalRank{0};
for (std::size_t j{0}; j < dummies; ++j) {
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
- if (const ActualArgument *arg{actualForDummy[j]}) {
+ if (const ActualArgument * arg{actualForDummy[j]}) {
bool isAssumedRank{IsAssumedRank(*arg)};
if (isAssumedRank && d.rank != Rank::anyOrAssumedRank &&
d.rank != Rank::arrayOrAssumedRank) {
@@ -2293,7 +2287,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case Rank::locReduced:
case Rank::scalarIfDim:
if (dummy[*dimArg].optionality == Optionality::required) {
- if (const Symbol *whole{
+ if (const Symbol *
+ whole{
UnwrapWholeSymbolOrComponentDataRef(actualForDummy[*dimArg])}) {
if (IsOptional(*whole) || IsAllocatableOrObjectPointer(whole)) {
if (context.languageFeatures().ShouldWarn(
@@ -2371,7 +2366,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
// Rearrange the actual arguments into dummy argument order.
ActualArguments rearranged(dummies);
for (std::size_t j{0}; j < dummies; ++j) {
- if (ActualArgument *arg{actualForDummy[j]}) {
+ if (ActualArgument * arg{actualForDummy[j]}) {
rearranged[j] = std::move(*arg);
}
}
@@ -2562,6 +2557,10 @@ bool IntrinsicProcTable::Implementation::IsIntrinsic(
}
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"}};
+
return std::find_if(std::begin(dualIntrinsic), std::end(dualIntrinsic),
[&name](const std::string &dualName) {
return dualName == name;
More information about the flang-commits
mailing list