initial commit

Author: akuhlens

flang-rt/lib/runtime/extensions.cpp

@@ -272,5 +272,8 @@ void FORTRAN_PROCEDURE_NAME(qsort)(int *array, int *len, int *isize,
 // PERROR(STRING)
 void RTNAME(Perror)(const char *str) { perror(str); }
 
+// GNU extension function TIME()
+std::int64_t RTNAME(time)() { return time(nullptr); }
+
 } // namespace Fortran::runtime
 } // extern "C"

flang/docs/Intrinsics.md

@@ -1091,6 +1091,27 @@ end program rename_proc
 This intrinsic is an alias for `CPU_TIME`: supporting both a subroutine and a
 function form.
 
+### Non-Standard Intrinsics: TIME
+
+#### Description
+`TIME()` returns the current time of the system as a INTEGER(8). 
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** function
+- **Syntax:** `RESULT = TIME()`
+
+#### Example
+```Fortran
+PROGRAM example_time
+  print *, TIME()
+  print *, TIME()
+  call SLEEP(10)
+  print *, TIME()
+END PROGRAM
+```
+
 ### Non-standard Intrinsics: LNBLNK
 This intrinsic is an alias for `LEN_TRIM`, without the optional KIND argument.
 

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

@@ -429,6 +429,7 @@ struct IntrinsicLibrary {
                                mlir::ArrayRef<fir::ExtendedValue> args);
   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genTand(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genTime(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genTransfer(mlir::Type,
                                  llvm::ArrayRef<fir::ExtendedValue>);

flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h

@@ -65,6 +65,9 @@ void genRandomSeed(fir::FirOpBuilder &, mlir::Location, mlir::Value size,
 void genRename(fir::FirOpBuilder &builder, mlir::Location loc,
                mlir::Value path1, mlir::Value path2, mlir::Value status);
 
+/// generate time runtime call
+mlir::Value genTime(fir::FirOpBuilder &builder, mlir::Location loc);
+
 /// generate runtime call to transfer intrinsic with no size argument
 void genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,
                  mlir::Value resultBox, mlir::Value sourceBox,

flang/include/flang/Runtime/extensions.h

@@ -65,6 +65,9 @@ std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int));
 // GNU extension subroutine SLEEP(SECONDS)
 void RTNAME(Sleep)(std::int64_t seconds);
 
+// GNU extension function TIME()
+std::int64_t RTNAME(time)();
+
 // GNU extension function ACCESS(NAME, MODE)
 // TODO: not supported on Windows
 #ifndef _WIN32

flang/lib/Evaluate/intrinsics.cpp

@@ -977,6 +977,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
         DefaultInt, Rank::vector, IntrinsicClass::transformationalFunction},
     {"this_image", {OptionalTEAM}, DefaultInt, Rank::scalar,
         IntrinsicClass::transformationalFunction},
+    {"time", {}, TypePattern{IntType, KindCode::exactKind, 8}, Rank::scalar,
+        IntrinsicClass::transformationalFunction},
     {"tiny",
         {{"x", SameReal, Rank::anyOrAssumedRank, Optionality::required,
             common::Intent::In, {ArgFlag::canBeMoldNull}}},

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -756,7 +756,7 @@ static constexpr IntrinsicHandler handlers[]{
     {"perror",
      &I::genPerror,
      {{{"string", asBox}}},
-     /*isElemental*/ false},
+     /*isElemental=*/false},
     {"popcnt", &I::genPopcnt},
     {"poppar", &I::genPoppar},
     {"present",
@@ -908,6 +908,7 @@ static constexpr IntrinsicHandler handlers[]{
     {"threadfence", &I::genThreadFence, {}, /*isElemental=*/false},
     {"threadfence_block", &I::genThreadFenceBlock, {}, /*isElemental=*/false},
     {"threadfence_system", &I::genThreadFenceSystem, {}, /*isElemental=*/false},
+    {"time", &I::genTime, {}, /*isElemental=*/false},
     {"trailz", &I::genTrailz},
     {"transfer",
      &I::genTransfer,
@@ -8386,6 +8387,14 @@ void IntrinsicLibrary::genThreadFenceSystem(
   builder.create<fir::CallOp>(loc, funcOp, noArgs);
 }
 
+// TIME
+mlir::Value IntrinsicLibrary::genTime(mlir::Type resultType,
+                                      llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() == 0);
+  return builder.createConvert(loc, resultType,
+                               fir::runtime::genTime(builder, loc));
+}
+
 // TRIM
 fir::ExtendedValue
 IntrinsicLibrary::genTrim(mlir::Type resultType,

flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp

@@ -252,6 +252,13 @@ void fir::runtime::genRename(fir::FirOpBuilder &builder, mlir::Location loc,
   builder.create<fir::CallOp>(loc, runtimeFunc, args);
 }
 
+/// generate runtime call to time intrinsic
+mlir::Value fir::runtime::genTime(
+    fir::FirOpBuilder &builder, mlir::Location loc) {
+  auto func = fir::runtime::getRuntimeFunc<mkRTKey(time)>(loc, builder);
+  return builder.create<fir::CallOp>(loc, func, std::nullopt).getResult(0);
+}
+
 /// generate runtime call to transfer intrinsic with no size argument
 void fir::runtime::genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,
                                mlir::Value resultBox, mlir::Value sourceBox,

flang/test/Lower/Intrinsics/time.f90

@@ -0,0 +1,17 @@
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK-LABEL: func.func @_QPtime_test() -> i64
+function time_test()
+  Integer(kind=8) :: time_test
+
+
+  !CHECK-DAG:   %[[func_result:.*]] = fir.alloca i64 {bindc_name = "time_test", uniq_name = "_QFtime_testEtime_test"}
+  !CHECK-DAG:   %[[func_result_decl:.*]]:{{.*}} = hlfir.declare %[[func_result]] {uniq_name = "_QFtime_testEtime_test"} : {{.*}}fir.ref<i64>{{.*}}
+  !CHECK:     %[[call_result:.*]] = fir.call @_FortranAtime()
+  !CHECK-SAME:  -> i64
+
+  !CHECK-DAG:   hlfir.assign %[[call_result]] to %[[func_result_decl]]#[[func_result]] : i64, !fir.ref<i64>
+  !CHECK-DAG:   %[[load_result:.*]] = fir.load %[[func_result_decl]]#[[func_result]] : !fir.ref<i64>
+  !CHECK:     return %[[load_result]] : i64
+  time_test = time()
+end function time_test