[flang-commits] [flang] [flang] Implement SECOND intrinsic (PR #98881)
Tom Eccles via flang-commits
flang-commits at lists.llvm.org
Tue Jul 16 03:29:21 PDT 2024
https://github.com/tblah updated https://github.com/llvm/llvm-project/pull/98881
>From 3ffb54a189bb4653720467b7f7d7517e4136f5d9 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Fri, 12 Jul 2024 15:28:22 +0000
Subject: [PATCH 1/2] [flang] Implement SECOND intrinsic
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.
---
flang/docs/Intrinsics.md | 13 +++++++
.../flang/Optimizer/Builder/IntrinsicCall.h | 2 +
flang/lib/Evaluate/intrinsics.cpp | 5 ++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 25 +++++++++++++
flang/test/Lower/Intrinsics/second.f90 | 37 +++++++++++++++++++
5 files changed, 81 insertions(+), 1 deletion(-)
create mode 100644 flang/test/Lower/Intrinsics/second.f90
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: }
>From 0764137b0589e1eb46be76a0e9bc615c07931c6d Mon Sep 17 00:00:00 2001
From: Tom Eccles <t at freedommail.info>
Date: Tue, 16 Jul 2024 11:29:13 +0100
Subject: [PATCH 2/2] Fix typo
Co-authored-by: Michael Klemm <michael.klemm at amd.com>
---
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 6f4093086455f..87716731ead85 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1054,7 +1054,7 @@ function form.
#### Usage and Info
-- **Stnadard:** GNU extension
+- **Standard:** GNU extension
- **Class:** Subroutine, function
- **Syntax:** `CALL SECOND(TIME)` or `TIME = SECOND()`
- **Arguments:** `TIME` - a REAL value into which the elapsed CPU time in
More information about the flang-commits
mailing list