[flang-commits] [flang] [flang] Implement non-standard RTC intrinsic (PR #182560)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

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

Author: Tom Eccles (tblah)

<details>
<summary>Changes</summary>

RTC is supported by classic flang and used in a proprietary HPC application. I've implemented it as an alias for TIME.

Assisted-by: codex

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


5 Files Affected:

- (modified) flang/docs/Intrinsics.md (+12) 
- (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+1) 
- (modified) flang/lib/Evaluate/intrinsics.cpp (+1) 
- (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+9) 
- (added) flang/test/Lower/Intrinsics/rtc.f90 (+16) 


``````````diff
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index faae4ae2aab9d..615d2746284ab 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1182,6 +1182,18 @@ END PROGRAM example_dsecnds
 This intrinsic is an alias for `CPU_TIME`: supporting both a subroutine and a
 function form.
 
+### Non-Standard Intrinsics: RTC
+
+#### Description
+`RTC()` returns the current time of the system as a REAL(8), interpreted as
+seconds since the Unix epoch.
+
+#### Usage and Info
+
+- **Standard:** Intel extension
+- **Class:** function
+- **Syntax:** `RESULT = RTC()`
+
 ### Non-Standard Intrinsics: TIME
 
 #### Description
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index fd875b6822838..edc6d1bf8e252 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -404,6 +404,7 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genRRSpacing(mlir::Type resultType,
                            llvm::ArrayRef<mlir::Value> args);
+  mlir::Value genRtc(mlir::Type resultType, llvm::ArrayRef<mlir::Value> args);
   fir::ExtendedValue genSameTypeAs(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 4186ca71651d8..9eaad6c049267 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -929,6 +929,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
             {"order", AnyInt, Rank::vector, Optionality::optional}},
         SameType, Rank::shaped, IntrinsicClass::transformationalFunction},
     {"rrspacing", {{"x", SameReal}}, SameReal},
+    {"rtc", {}, TypePattern{RealType, KindCode::exactKind, 8}, Rank::scalar},
     {"same_type_as",
         {{"a", ExtensibleDerived, Rank::anyOrAssumedRank, Optionality::required,
              common::Intent::In, {ArgFlag::canBeMoldNull}},
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index d3c67395a08bd..f71ef0f12c992 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -685,6 +685,7 @@ static constexpr IntrinsicHandler handlers[]{
        {"order", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"rrspacing", &I::genRRSpacing},
+    {"rtc", &I::genRtc, {}, /*isElemental=*/false},
     {"same_type_as",
      &I::genSameTypeAs,
      {{{"a", asBox}, {"b", asBox}}},
@@ -7762,6 +7763,14 @@ IntrinsicLibrary::genSecond(std::optional<mlir::Type> resultType,
   return {};
 }
 
+// RTC
+mlir::Value IntrinsicLibrary::genRtc(mlir::Type resultType,
+                                     llvm::ArrayRef<mlir::Value> args) {
+  assert(args.empty());
+  mlir::Value time = fir::runtime::genTime(builder, loc);
+  return builder.createConvert(loc, resultType, time);
+}
+
 // SELECTED_CHAR_KIND
 fir::ExtendedValue
 IntrinsicLibrary::genSelectedCharKind(mlir::Type resultType,
diff --git a/flang/test/Lower/Intrinsics/rtc.f90 b/flang/test/Lower/Intrinsics/rtc.f90
new file mode 100644
index 0000000000000..17f5fb5526fe3
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/rtc.f90
@@ -0,0 +1,16 @@
+!RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+subroutine test_rtc(time)
+  real(8) :: time
+  time = rtc()
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_rtc(
+! CHECK-SAME:                                %[[VAL_0:.*]]: !fir.ref<f64> {fir.bindc_name = "time"}) {
+! CHECK:           %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_2]] arg {{[0-9]+}} {uniq_name = "_QFtest_rtcEtime"} : (!fir.ref<f64>, !fir.dscope) -> (!fir.ref<f64>, !fir.ref<f64>)
+! CHECK:           %[[VAL_4:.*]] = fir.call @_FortranAtime() fastmath<contract> : () -> i64
+! CHECK:           %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> f64
+! CHECK:           hlfir.assign %[[VAL_5]] to %[[VAL_3]]#0 : f64, !fir.ref<f64>
+! CHECK:           return
+! CHECK:         }

``````````

</details>


https://github.com/llvm/llvm-project/pull/182560