[flang-commits] [flang] [flang] Add ETIME runtime and lowering intrinsics implementation (PR #90578)
via flang-commits
flang-commits at lists.llvm.org
Tue Apr 30 02:39:00 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-runtime
@llvm/pr-subscribers-flang-semantics
Author: jiajie zhang (JumpMasterJJ)
<details>
<summary>Changes</summary>
This patch add support of intrinsics GNU extension ETIME. Some usage info and example has been added to `flang/docs/Intrinsics.md`. The patch contains both the lowering and the runtime code and works on both Windows and Linux.
| System | Implmentation |
|-----------|--------------------|
| Windows| GetProcessTimes |
| Linux |times |
---
Full diff: https://github.com/llvm/llvm-project/pull/90578.diff
11 Files Affected:
- (modified) flang/docs/Intrinsics.md (+51)
- (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+1)
- (modified) flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h (+2)
- (modified) flang/include/flang/Runtime/time-intrinsic.h (+3)
- (modified) flang/lib/Evaluate/intrinsics.cpp (+10-3)
- (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+21)
- (modified) flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp (+14)
- (modified) flang/runtime/time-intrinsic.cpp (+69-1)
- (modified) flang/runtime/tools.h (+9)
- (added) flang/test/Lower/Intrinsics/etime.f90 (+21)
- (added) flang/test/Semantics/etime.f90 (+21)
``````````diff
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 848619cb65d909..46889bd1415226 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
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 6927488517e63b..5c385c04ac3e9d 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 737c631e45c1f6..7497a4bc35646f 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 650c02436ee49e..80490a17e45597 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 f07f94b1a022c9..b77df3df756256 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1340,6 +1340,12 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"values", AnyInt, Rank::vector, Optionality::optional,
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},
{"execute_command_line",
{{"command", DefaultChar, Rank::scalar},
{"wait", AnyLogical, Rank::scalar, Optionality::optional},
@@ -1939,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) {
@@ -2277,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(
@@ -2355,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);
}
}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 4ee7258004fa74..f0b0b7c74cf5ac 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 57c47da0f3f85c..f1e62484e6502e 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 68d63253139f18..93b782693c4cc9 100644
--- a/flang/runtime/time-intrinsic.cpp
+++ b/flang/runtime/time-intrinsic.cpp
@@ -19,8 +19,12 @@
#include <cstdlib>
#include <cstring>
#include <ctime>
-#ifndef _WIN32
+#ifdef _WIN32
+#include "flang/Common/windows-include.h"
+#else
#include <sys/time.h> // gettimeofday
+#include <sys/times.h>
+#include <unistd.h>
#endif
// CPU_TIME (Fortran 2018 16.9.57)
@@ -370,5 +374,69 @@ 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};
+
+ 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;
+ 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()};
+ // 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 52049c511f13ed..dc12e5c4533e2e 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);
diff --git a/flang/test/Lower/Intrinsics/etime.f90 b/flang/test/Lower/Intrinsics/etime.f90
new file mode 100644
index 00000000000000..e5e7984a340caa
--- /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 00000000000000..176b63b2a576dc
--- /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
``````````
</details>
https://github.com/llvm/llvm-project/pull/90578
More information about the flang-commits
mailing list