[flang] Add ETIME runtime and lowering intrinsics implementation

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>
+  }
+}

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
+```

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>);
@@ -398,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
@@ -440,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.

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);

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_

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},
@@ -1340,6 +1344,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},
@@ -2482,6 +2492,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;
@@ -2543,6 +2554,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 {
@@ -3074,7 +3096,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);
@@ -3209,7 +3231,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);

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},
@@ -1677,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,
@@ -1720,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,
@@ -1815,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
 //===----------------------------------------------------------------------===//
@@ -3230,6 +3298,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);

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) {