Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 17 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
89 changes: 89 additions & 0 deletions flang-rt/lib/runtime/extensions.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down Expand Up @@ -303,6 +304,94 @@ 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)
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is ready for review. I did some testing with multiple threads. Test program:

use omp_lib
external secnds
real sec_mid
real results(1000)
integer i, num_threads

results = 0.0
!$omp parallel do
do i=1, size(results)
  results(i) = secnds(0.0)
  num_threads = omp_get_num_threads()
end do
!$omp end parallel do

print *, "Number of threads in parallel region:", num_threads

sec_mid = minval(results)
print *, "Seconds from midnight: min:", sec_mid, ", max:", maxval(results) 

call sleep(2)

!$omp parallel do
do i=1, size(results)
  results(i) = secnds(sec_mid)
end do
!$omp end parallel do

print *, "Seconds from sec_mid: min:", minval(results), ", max:", maxval(results)
print *, "Seconds from midnight:", secnds(0.0)
end

Output:

$ ./a.out 
 Number of threads in parallel region: 256
 Seconds from midnight: min: 46489. , max: 46489.
 Seconds from sec_mid: min: 2. , max: 2.
 Seconds from midnight: 46491.

float FORTRAN_PROCEDURE_NAME(secnds)(float *refTime) {
constexpr float FAIL_SECNDS{-1.0f}; // 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}};
constexpr std::time_t TIME_INITIALIZING{std::time_t{1}};
if (!refTime) {
return FAIL_SECNDS;
}
std::time_t now{std::time(nullptr)};
if (now == FAIL_TIME) {
return FAIL_SECNDS;
}
// In float result, we can only precisely store 2^24 seconds, which
// comes out to about 194 days. Thus, need to pick a starting point.
// Given the description of this function, midnight of the current
// day is the best starting point.
//
// In addition, use atomic operations for thread safety. startingPoint
// also acts as a state variable that can take on the following values:
// TIME_UNINITIALIZED to indicate that it's not initialized,
// TIME_INITIALIZING to indicate that it is being initialized,
// any other value to indicate the starting point time.
static std::atomic<std::time_t> startingPoint{TIME_UNINITIALIZED};
std::time_t localStartingPoint{TIME_UNINITIALIZED};
// Use retry logic to ensure that in case of multiple threads, one thread
// will perform initialization and the other threads wait their turn.
for (;;) {
// "Acquire" will show writes from other threads.
std::time_t currentStartingPoint{
startingPoint.load(std::memory_order_acquire)};
if (currentStartingPoint > TIME_INITIALIZING) {
// Initialization was already done, use the starting point value
localStartingPoint = currentStartingPoint;
break;
} else if (currentStartingPoint == TIME_INITIALIZING) {
// Some other thread is currently initializing
std::this_thread::yield();
continue;
} else if (currentStartingPoint == TIME_UNINITIALIZED) {
// Try to start initialization
std::time_t expected{TIME_UNINITIALIZED};
if (startingPoint.compare_exchange_strong(expected, TIME_INITIALIZING,
std::memory_order_acq_rel, // "Acquire and release" on success
std::memory_order_acquire)) { // "Acquire" on failure
// This thread is doing initialization of startingPoint
struct tm timeInfo;
#ifdef _WIN32
if (localtime_s(&timeInfo, &now)) {
#else
if (!localtime_r(&now, &timeInfo)) {
#endif
// "Relaxed" ensures atomicity, but not ordering
startingPoint.store(TIME_UNINITIALIZED, std::memory_order_relaxed);
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) {
startingPoint.store(TIME_UNINITIALIZED, std::memory_order_relaxed);
return FAIL_SECNDS;
}
// "Release" will make this value available to other threads
startingPoint.store(localStartingPoint, std::memory_order_release);
break;
} else {
// This thread couln't start initialization. Try again.
continue;
}
}
}
if (localStartingPoint <= TIME_INITIALIZING) {
return FAIL_SECNDS;
}
double diffStartingPoint{std::difftime(now, localStartingPoint)};
return static_cast<float>(diffStartingPoint) - *refTime;
}

float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line) {
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Moved _FortranA... function to here.

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); }

Expand Down
2 changes: 2 additions & 0 deletions flang/include/flang/Runtime/command.h
Original file line number Diff line number Diff line change
Expand Up @@ -67,6 +67,8 @@ std::int32_t RTNAME(Hostnm)(
std::int32_t RTNAME(PutEnv)(
const char *str, size_t str_length, const char *sourceFile, int line);

float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line);
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This should be moved over to extensions.h.


// Calls unlink()
std::int32_t RTNAME(Unlink)(
const char *path, size_t pathLength, const char *sourceFile, int line);
Expand Down
3 changes: 3 additions & 0 deletions flang/include/flang/Runtime/extensions.h
Original file line number Diff line number Diff line change
Expand Up @@ -90,5 +90,8 @@ 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);

} // extern "C"
#endif // FORTRAN_RUNTIME_EXTENSIONS_H_