[flang-rt] Runtime implementation of extended intrinsic function SECNDS() (#152021)

Until the compiler part is fully hooked up via
#151878, tested this using
`external`:
```
external secnds
real s1, s2
s1 = secnds(0.0)
print *, "Seconds from midnight:", s1
call sleep(2)
s2 = secnds(s1)
print *, "Seconds from s1", s2
print *, "Seconds from midnight:", secnds(0.0)
end
```

Author: eugeneepshteyn

flang-rt/lib/runtime/extensions.cpp

@@ -18,6 +18,7 @@
 #include "flang/Runtime/entry-names.h"
 #include "flang/Runtime/io-api.h"
 #include "flang/Runtime/iostat-consts.h"
+#include <atomic>
 #include <chrono>
 #include <cstdio>
 #include <cstring>
@@ -57,10 +58,76 @@ inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
 #include <direct.h>
 #endif
 
-extern "C" {
-
 namespace Fortran::runtime {
 
+// Common implementation that could be used for either SECNDS() or SECNDSD(),
+// which are defined for float or double.
+template <typename T> T SecndsImpl(T *refTime) {
+  static_assert(std::is_same<T, float>::value || std::is_same<T, double>::value,
+      "T must be float or double");
+  constexpr T FAIL_SECNDS{T{-1.0}}; // Failure code for this function
+  // Failure code for time functions that return std::time_t
+  constexpr std::time_t FAIL_TIME{std::time_t{-1}};
+  constexpr std::time_t TIME_UNINITIALIZED{std::time_t{0}};
+  if (!refTime) {
+    return FAIL_SECNDS;
+  }
+  std::time_t now{std::time(nullptr)};
+  if (now == FAIL_TIME) {
+    return FAIL_SECNDS;
+  }
+  // In case we are using a float result, we can only precisely store
+  // 2^24 seconds, which comes out to about 194 days. Thus, need to pick
+  // a starting point, which will allow us to keep the time diffs as precise
+  // as possible. Given the description of this function, midnight of the
+  // current day is the best starting point.
+  static std::atomic<std::time_t> startingPoint{TIME_UNINITIALIZED};
+  // "Acquire" will give us writes from other threads.
+  std::time_t localStartingPoint{startingPoint.load(std::memory_order_acquire)};
+  // Initialize startingPoint if we haven't initialized it yet or
+  // if we were passed 0.0, which indicates to compute seconds from
+  // current day's midnight.
+  if (localStartingPoint == TIME_UNINITIALIZED || *refTime == 0.0) {
+    // Compute midnight in the current timezone and try to initialize
+    // startingPoint with it. If there are any errors during computation,
+    // exit with error and hope that the other threads have better luck
+    // (or the user retries the call).
+    struct tm timeInfo;
+#ifdef _WIN32
+    if (localtime_s(&timeInfo, &now)) {
+#else
+    if (!localtime_r(&now, &timeInfo)) {
+#endif
+      return FAIL_SECNDS;
+    }
+    // Back to midnight
+    timeInfo.tm_hour = 0;
+    timeInfo.tm_min = 0;
+    timeInfo.tm_sec = 0;
+    localStartingPoint = std::mktime(&timeInfo);
+    if (localStartingPoint == FAIL_TIME) {
+      return FAIL_SECNDS;
+    }
+    INTERNAL_CHECK(localStartingPoint > TIME_UNINITIALIZED);
+    // Attempt to atomically set startingPoint to localStartingPoint
+    std::time_t expected{TIME_UNINITIALIZED};
+    if (startingPoint.compare_exchange_strong(expected, localStartingPoint,
+            std::memory_order_acq_rel, // "Acquire and release" on success
+            std::memory_order_acquire)) { // "Acquire" on failure
+      // startingPoint was set to localStartingPoint
+    } else {
+      // startingPoint was already initialized and its value was loaded
+      // into `expected`. Discard our precomputed midnight value in favor
+      // of the one from startingPoint.
+      localStartingPoint = expected;
+    }
+  }
+  double diffStartingPoint{std::difftime(now, localStartingPoint)};
+  return static_cast<T>(diffStartingPoint) - *refTime;
+}
+
+extern "C" {
+
 gid_t RTNAME(GetGID)() {
 #ifdef _WIN32
   // Group IDs don't exist on Windows, return 1 to avoid errors
@@ -303,6 +370,17 @@ void FORTRAN_PROCEDURE_NAME(qsort)(int *array, int *len, int *isize,
 // PERROR(STRING)
 void RTNAME(Perror)(const char *str) { perror(str); }
 
+// GNU extension function SECNDS(refTime)
+float FORTRAN_PROCEDURE_NAME(secnds)(float *refTime) {
+  return SecndsImpl(refTime);
+}
+
+float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line) {
+  Terminator terminator{sourceFile, line};
+  RUNTIME_CHECK(terminator, refTime != nullptr);
+  return FORTRAN_PROCEDURE_NAME(secnds)(refTime);
+}
+
 // GNU extension function TIME()
 std::int64_t RTNAME(time)() { return time(nullptr); }
 
@@ -337,5 +415,6 @@ std::int64_t RTNAME(Ftell)(int unitNumber) {
 }
 } // namespace io
 
-} // namespace Fortran::runtime
 } // extern "C"
+
+} // namespace Fortran::runtime

flang/include/flang/Runtime/extensions.h

@@ -90,5 +90,9 @@ void RTNAME(Perror)(const char *str);
 // MCLOCK -- returns accumulated time in ticks
 int FORTRAN_PROCEDURE_NAME(mclock)();
 
+// GNU extension subroutine SECNDS(refTime)
+float FORTRAN_PROCEDURE_NAME(secnds)(float *refTime);
+float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line);
+
 } // extern "C"
 #endif // FORTRAN_RUNTIME_EXTENSIONS_H_