[flang] Implement SECOND intrinsic

[tblah]

The SECOND intrinsic is a gnu extension providing an alias for CPU_TIME: https://gcc.gnu.org/onlinedocs/gfortran/SECOND.html

This cannot be implemented as a straightforward alias because there is both a function and a subroutine form.

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

@llvm/pr-subscribers-flang-semantics

Author: Tom Eccles (tblah)

Changes

The SECOND intrinsic is a gnu extension providing an alias for CPU_TIME: https://gcc.gnu.org/onlinedocs/gfortran/SECOND.html

This cannot be implemented as a straightforward alias because there is both a function and a subroutine form.

---

Full diff: https://github.com/llvm/llvm-project/pull/98881.diff

5 Files Affected:

• (modified) flang/docs/Intrinsics.md (+13)
• (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+2)
• (modified) flang/lib/Evaluate/intrinsics.cpp (+4-1)
• (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+25)
• (added) flang/test/Lower/Intrinsics/second.f90 (+37)

diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 3009f25d39c2b..6f4093086455f 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1047,3 +1047,16 @@ program rename_proc
     call rename('dst', 'src')
 end program rename_proc
 ```
+
+### Non-standard Intrinsics: SECOND
+This intrinsic is an alias for `CPU_TIME`: supporting both a subroutine and a
+function form.
+
+#### Usage and Info
+
+- **Stnadard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL SECOND(TIME)` or `TIME = SECOND()`
+- **Arguments:** `TIME` - a REAL value into which the elapsed CPU time in
+                          seconds is written
+- **RETURN value:** same as TIME argument
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index a5f701bee5120..80f077ad133f3 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -357,6 +357,8 @@ struct IntrinsicLibrary {
                                    llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genSecond(std::optional<mlir::Type>,
+                               mlir::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSelectedCharKind(mlir::Type,
                                          llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genSelectedIntKind(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index e8f3c5f1161af..039dbcb82f745 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -822,6 +822,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
             {"back", AnyLogical, Rank::elemental, Optionality::optional},
             DefaultingKIND},
         KINDInt},
+    {"second", {}, DefaultReal, Rank::scalar},
     {"selected_char_kind", {{"name", DefaultChar, Rank::scalar}}, DefaultInt,
         Rank::scalar, IntrinsicClass::transformationalFunction},
     {"selected_int_kind", {{"r", AnyInt, Rank::scalar}}, DefaultInt,
@@ -1474,6 +1475,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"status", DefaultInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::scalar, IntrinsicClass::impureSubroutine},
+    {"second", {{"time", DefaultReal, Rank::scalar}}, {}, Rank::scalar,
+        IntrinsicClass::impureSubroutine},
     {"system",
         {{"command", DefaultChar, Rank::scalar},
             {"exitstat", DefaultInt, Rank::scalar, Optionality::optional,
@@ -2623,7 +2626,7 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
   // Collection for some intrinsics with function and subroutine form,
   // in order to pass the semantic check.
   static const std::string dualIntrinsic[]{
-      {"etime"s}, {"getcwd"s}, {"rename"s}};
+      {"etime"s}, {"getcwd"s}, {"rename"s}, {"second"s}};
 
   return std::find_if(std::begin(dualIntrinsic), std::end(dualIntrinsic),
              [&name](const std::string &dualName) {
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 6f49f46a7bf54..e12e21bb00e15 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -583,6 +583,10 @@ static constexpr IntrinsicHandler handlers[]{
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/true},
+    {"second",
+     &I::genSecond,
+     {{{"time", asAddr}}},
+     /*isElemental=*/false},
     {"selected_char_kind",
      &I::genSelectedCharKind,
      {{{"name", asAddr}}},
@@ -6140,6 +6144,27 @@ IntrinsicLibrary::genScan(mlir::Type resultType,
   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
 }
 
+// SECOND
+fir::ExtendedValue
+IntrinsicLibrary::genSecond(std::optional<mlir::Type> resultType,
+                            mlir::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1 && !resultType || args.empty() && resultType);
+
+  fir::ExtendedValue result;
+
+  if (resultType)
+    result = builder.createTemporary(loc, *resultType);
+  else
+    result = args[0];
+
+  llvm::SmallVector<fir::ExtendedValue, 1> subroutineArgs(1, result);
+  genCpuTime(subroutineArgs);
+
+  if (resultType)
+    return result;
+  return {};
+}
+
 // SELECTED_CHAR_KIND
 fir::ExtendedValue
 IntrinsicLibrary::genSelectedCharKind(mlir::Type resultType,
diff --git a/flang/test/Lower/Intrinsics/second.f90 b/flang/test/Lower/Intrinsics/second.f90
new file mode 100644
index 0000000000000..f1e66506aaaca
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/second.f90
@@ -0,0 +1,37 @@
+!RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+subroutine test_subroutine(time)
+  real :: time
+  call second(time)
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_subroutine(
+! CHECK-SAME:                                  %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "time"}) {
+! CHECK:           %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {uniq_name = "_QFtest_subroutineEtime"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK:           %[[VAL_3:.*]] = fir.call @_FortranACpuTime() fastmath<contract> : () -> f64
+! CHECK:           %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (f64) -> f32
+! CHECK:           fir.store %[[VAL_4]] to %[[VAL_2]]#1 : !fir.ref<f32>
+! CHECK:           return
+! CHECK:         }
+
+
+subroutine test_function(time)
+  real :: time
+  time = second()
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_function(
+! CHECK-SAME:                                %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "time"}) {
+! CHECK:           %[[VAL_1:.*]] = fir.alloca f32
+! CHECK:           %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_2]] {uniq_name = "_QFtest_functionEtime"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK:           %[[VAL_4:.*]] = fir.call @_FortranACpuTime() fastmath<contract> : () -> f64
+! CHECK:           %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (f64) -> f32
+! CHECK:           fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref<f32>
+! CHECK:           %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK:           %[[VAL_7:.*]] = arith.constant false
+! CHECK:           %[[VAL_8:.*]] = hlfir.as_expr %[[VAL_6]]#0 move %[[VAL_7]] : (!fir.ref<f32>, i1) -> !hlfir.expr<f32>
+! CHECK:           hlfir.assign %[[VAL_8]] to %[[VAL_3]]#0 : !hlfir.expr<f32>, !fir.ref<f32>
+! CHECK:           hlfir.destroy %[[VAL_8]] : !hlfir.expr<f32>
+! CHECK:           return
+! CHECK:         }

[mjklemm]

LGTM (with nit about typo :-))

[jeanPerier]

Thanks

[Thirumalai-Shaktivel]

This causes the build to fail, can you please check?

[...]
/home/tshaktiv/Projects/llvm-project/flang/lib/Optimizer/Builder/IntrinsicCall.cpp:6151:27: error: suggest parentheses around ‘&&’ within ‘||’ [-Werror=parentheses]
 6151 |   assert(args.size() == 1 && !resultType || args.empty() && resultType);
      |          ~~~~~~~~~~~~~~~~~^~~~~~~~~~~~~~
cc1plus: all warnings being treated as errors

[tblah]

Thanks. See #99306