[flang-commits] [flang] 245b7b6 - [flang] Add ETIME runtime and lowering intrinsics implementation (#90578)
via flang-commits
flang-commits at lists.llvm.org
Wed May 15 21:43:44 PDT 2024
Author: jiajie zhang
Date: 2024-05-16T12:42:01+08:00
New Revision: 245b7b65cb341ac5499fabf62f28fdbbc39bc7d7
URL: https://github.com/llvm/llvm-project/commit/245b7b65cb341ac5499fabf62f28fdbbc39bc7d7
DIFF: https://github.com/llvm/llvm-project/commit/245b7b65cb341ac5499fabf62f28fdbbc39bc7d7.diff
LOG: [flang] Add ETIME runtime and lowering intrinsics implementation (#90578)
This patch add support of intrinsics GNU extension ETIME
https://github.com/llvm/llvm-project/issues/84205. 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 |
Added:
etime-function.mlir
flang/test/Lower/Intrinsics/etime-function.f90
flang/test/Lower/Intrinsics/etime.f90
flang/test/Semantics/etime.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/time-intrinsic.h
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
flang/runtime/time-intrinsic.cpp
flang/runtime/tools.h
Removed:
################################################################################
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/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 848619cb65d90..41129b10083b1 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -916,3 +916,55 @@ 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 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:
+
+
+| | |
+|---------------|-----------------------------------|
+| `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, function
+- **Syntax:** `CALL ETIME(VALUES, TIME)`
+- **Arguments:**
+- **Return value** Elapsed time in seconds since the start of program execution.
+
+| Argument | Description |
+|------------|-----------------------------------------------------------------------|
+| `VALUES` | The type shall be REAL(4), DIMENSION(2). |
+| `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
+ 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 b7d0609267613..977a69af52813 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -222,6 +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);
+ 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>);
@@ -400,8 +402,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
@@ -442,6 +446,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/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 441a762c930d8..ded277877f49d 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},
@@ -1342,6 +1346,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},
@@ -2484,6 +2494,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;
@@ -2545,6 +2556,17 @@ bool IntrinsicProcTable::Implementation::IsIntrinsic(
const std::string &name) const {
return IsIntrinsicFunction(name) || IsIntrinsicSubroutine(name);
}
+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;
+ }) != std::end(dualIntrinsic);
+}
IntrinsicClass IntrinsicProcTable::Implementation::GetIntrinsicClass(
const std::string &name) const {
@@ -3083,7 +3105,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);
@@ -3218,7 +3240,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 58064d23eb080..ae7e650987448 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"
@@ -222,6 +224,10 @@ 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},
@@ -1682,6 +1688,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,
@@ -1725,6 +1749,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,
@@ -1820,6 +1860,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,6 +3303,37 @@ void IntrinsicLibrary::genExecuteCommandLine(
exitstatBox, cmdstatBox, cmdmsgBox);
}
+// ETIME
+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]);
+ 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
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 8b78a1688c731..3f36d639861b1 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..989d4f804c5f7 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) == 0) {
+ ULARGE_INTEGER userSystemTime;
+ ULARGE_INTEGER kernelSystemTime;
+
+ memcpy(&userSystemTime, &userTime, sizeof(FILETIME));
+ memcpy(&kernelSystemTime, &kernelTime, sizeof(FILETIME));
+
+ 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);
+ 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 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);
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/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..28735c2a7aacf
--- /dev/null
+++ b/flang/test/Semantics/etime.f90
@@ -0,0 +1,30 @@
+! 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 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
+ call etime(values, time)
+end subroutine good_kind_equal
\ No newline at end of file
More information about the flang-commits
mailing list