584 lines · cpp
1//===-- lib/runtime/time-intrinsic.cpp --------------------------*- C++ -*-===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9// Implements time-related intrinsic subroutines.10 11#include "flang/Runtime/time-intrinsic.h"12#include "flang-rt/runtime/descriptor.h"13#include "flang-rt/runtime/terminator.h"14#include "flang-rt/runtime/tools.h"15#include "flang/Runtime/cpp-type.h"16#include <algorithm>17#include <cstdint>18#include <cstdio>19#include <cstdlib>20#include <cstring>21#include <ctime>22#ifdef _WIN3223#include "flang/Common/windows-include.h"24#else25#include <sys/time.h> // gettimeofday26#include <sys/times.h>27#include <unistd.h>28#endif29 30// CPU_TIME (Fortran 2018 16.9.57)31// SYSTEM_CLOCK (Fortran 2018 16.9.168)32//33// We can use std::clock() from the <ctime> header as a fallback implementation34// that should be available everywhere. This may not provide the best resolution35// and is particularly troublesome on (some?) POSIX systems where CLOCKS_PER_SEC36// is defined as 10^6 regardless of the actual precision of std::clock().37// Therefore, we will usually prefer platform-specific alternatives when they38// are available.39//40// We can use SFINAE to choose a platform-specific alternative. To do so, we41// introduce a helper function template, whose overload set will contain only42// implementations relying on interfaces which are actually available. Each43// overload will have a dummy parameter whose type indicates whether or not it44// should be preferred. Any other parameters required for SFINAE should have45// default values provided.46namespace {47 48using namespace Fortran;49 50// Types for the dummy parameter indicating the priority of a given overload.51// We will invoke our helper with an integer literal argument, so the overload52// with the highest priority should have the type int.53using fallback_implementation = double;54using preferred_implementation = int;55 56// This is the fallback implementation, which should work everywhere.57template <typename Unused = void> double GetCpuTime(fallback_implementation) {58 std::clock_t timestamp{std::clock()};59 if (timestamp != static_cast<std::clock_t>(-1)) {60 return static_cast<double>(timestamp) / CLOCKS_PER_SEC;61 }62 // Return some negative value to represent failure.63 return -1.0;64}65 66// struct timespec and timespec_get are not implemented in macOS 10.14. Using67// it here limits which version of MacOS we are compatible with. Unfortunately68// when building on newer MacOS for older MacOS it uses the new headers (with69// a definition of struct timespec) but just errors on API calls so we can't use70// overloading magic to trigger different implementations depending if struct71// timespec is defined.72#if defined __APPLE__73#define NO_TIMESPEC74#else75#undef NO_TIMESPEC76#endif77 78#if defined __MINGW32__79// clock_gettime is implemented in the pthread library for MinGW.80// Using it here would mean that all programs that link libflang_rt are81// required to also link to pthread. Instead, don't use the function.82#undef CLOCKID_CPU_TIME83#undef CLOCKID_ELAPSED_TIME84#else85// Determine what clock to use for CPU time.86#if defined CLOCK_PROCESS_CPUTIME_ID87#define CLOCKID_CPU_TIME CLOCK_PROCESS_CPUTIME_ID88#elif defined CLOCK_THREAD_CPUTIME_ID89#define CLOCKID_CPU_TIME CLOCK_THREAD_CPUTIME_ID90#else91#undef CLOCKID_CPU_TIME92#endif93 94// Determine what clock to use for elapsed time.95#if defined CLOCK_MONOTONIC96#define CLOCKID_ELAPSED_TIME CLOCK_MONOTONIC97#elif defined CLOCK_REALTIME98#define CLOCKID_ELAPSED_TIME CLOCK_REALTIME99#else100#undef CLOCKID_ELAPSED_TIME101#endif102#endif103 104#ifdef CLOCKID_CPU_TIME105#ifndef NO_TIMESPEC106// POSIX implementation using clock_gettime. This is only enabled where107// clock_gettime is available.108template <typename T = int, typename U = struct timespec>109double GetCpuTime(preferred_implementation,110 // We need some dummy parameters to pass to decltype(clock_gettime).111 T ClockId = 0, U *Timespec = nullptr,112 decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {113 struct timespec tspec;114 if (clock_gettime(CLOCKID_CPU_TIME, &tspec) == 0) {115 return tspec.tv_nsec * 1.0e-9 + tspec.tv_sec;116 }117 // Return some negative value to represent failure.118 return -1.0;119}120#endif // !NO_TIMESPEC121#endif // CLOCKID_CPU_TIME122 123using count_t = std::int64_t;124using unsigned_count_t = std::uint64_t;125 126// POSIX implementation using clock_gettime where available. The clock_gettime127// result is in nanoseconds, which is converted as necessary to128// - deciseconds for kind 1129// - milliseconds for kinds 2, 4130// - nanoseconds for kinds 8, 16131constexpr unsigned_count_t DS_PER_SEC{10u};132constexpr unsigned_count_t MS_PER_SEC{1'000u};133[[maybe_unused]] constexpr unsigned_count_t US_PER_SEC{1'000'000u};134constexpr unsigned_count_t NS_PER_SEC{1'000'000'000u};135 136// Computes HUGE(INT(0,kind)) as an unsigned integer value.137static constexpr inline unsigned_count_t GetHUGE(int kind) {138 if (kind > 8) {139 kind = 8;140 }141 return (unsigned_count_t{1} << ((8 * kind) - 1)) - 1;142}143 144count_t ConvertSecondsNanosecondsToCount(145 int kind, unsigned_count_t sec, unsigned_count_t nsec) {146 const unsigned_count_t huge{GetHUGE(kind)};147 if (kind >= 8) {148 return (sec * NS_PER_SEC + nsec) % (huge + 1);149 } else if (kind >= 2) {150 return (sec * MS_PER_SEC + (nsec / (NS_PER_SEC / MS_PER_SEC))) % (huge + 1);151 } else { // kind == 1152 return (sec * DS_PER_SEC + (nsec / (NS_PER_SEC / DS_PER_SEC))) % (huge + 1);153 }154}155 156// Less accurate implementation only accurate to the nearest microsecond157// (instead of nanosecond) for systems where `struct timespec` is not available.158#if defined(NO_TIMESPEC) && !defined(_WIN32)159// Function converts a struct timeval into the desired count to160// be returned by the timing functions in accordance with the requested161// kind at the call site.162count_t ConvertTimevalToCount(int kind, const struct timeval &tval) {163 unsigned_count_t sec{static_cast<unsigned_count_t>(tval.tv_sec)};164 unsigned_count_t nsec{static_cast<unsigned_count_t>(tval.tv_usec) * 1000};165 return ConvertSecondsNanosecondsToCount(kind, sec, nsec);166}167 168template <typename Unused = void>169count_t GetSystemClockCount(int kind, fallback_implementation) {170 struct timeval tval;171 172 if (gettimeofday(&tval, /*timezone=*/nullptr) != 0) {173 // Return -HUGE(COUNT) to represent failure.174 return -static_cast<count_t>(GetHUGE(kind));175 }176 177 // Compute the timestamp as seconds plus nanoseconds in accordance178 // with the requested kind at the call site.179 return ConvertTimevalToCount(kind, tval);180}181 182#else183 184// Function converts a std::timespec_t into the desired count to185// be returned by the timing functions in accordance with the requested186// kind at the call site.187count_t ConvertTimeSpecToCount(int kind, const struct timespec &tspec) {188 unsigned_count_t sec{static_cast<unsigned_count_t>(tspec.tv_sec)};189 unsigned_count_t nsec{static_cast<unsigned_count_t>(tspec.tv_nsec)};190 return ConvertSecondsNanosecondsToCount(kind, sec, nsec);191}192 193#ifndef _AIX194// More accurate version with nanosecond accuracy195template <typename Unused = void>196count_t GetSystemClockCount(int kind, fallback_implementation) {197 struct timespec tspec;198 199 if (timespec_get(&tspec, TIME_UTC) < 0) {200 // Return -HUGE(COUNT) to represent failure.201 return -static_cast<count_t>(GetHUGE(kind));202 }203 204 // Compute the timestamp as seconds plus nanoseconds in accordance205 // with the requested kind at the call site.206 return ConvertTimeSpecToCount(kind, tspec);207}208#endif // !_AIX209#endif // !NO_TIMESPEC210 211template <typename Unused = void>212count_t GetSystemClockCountRate(int kind, fallback_implementation) {213#ifdef NO_TIMESPEC214 return kind >= 8 ? US_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC;215#else216 return kind >= 8 ? NS_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC;217#endif218}219 220template <typename Unused = void>221count_t GetSystemClockCountMax(int kind, fallback_implementation) {222 unsigned_count_t maxCount{GetHUGE(kind)};223 return maxCount;224}225 226#ifndef NO_TIMESPEC227#ifdef CLOCKID_ELAPSED_TIME228template <typename T = int, typename U = struct timespec>229count_t GetSystemClockCount(int kind, preferred_implementation,230 // We need some dummy parameters to pass to decltype(clock_gettime).231 T ClockId = 0, U *Timespec = nullptr,232 decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {233 struct timespec tspec;234 const unsigned_count_t huge{GetHUGE(kind)};235 if (clock_gettime(CLOCKID_ELAPSED_TIME, &tspec) != 0) {236 return -huge; // failure237 }238 239 // Compute the timestamp as seconds plus nanoseconds in accordance240 // with the requested kind at the call site.241 return ConvertTimeSpecToCount(kind, tspec);242}243#endif // CLOCKID_ELAPSED_TIME244 245template <typename T = int, typename U = struct timespec>246count_t GetSystemClockCountRate(int kind, preferred_implementation,247 // We need some dummy parameters to pass to decltype(clock_gettime).248 T ClockId = 0, U *Timespec = nullptr,249 decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {250 return kind >= 8 ? NS_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC;251}252 253template <typename T = int, typename U = struct timespec>254count_t GetSystemClockCountMax(int kind, preferred_implementation,255 // We need some dummy parameters to pass to decltype(clock_gettime).256 T ClockId = 0, U *Timespec = nullptr,257 decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {258 return GetHUGE(kind);259}260#endif // !NO_TIMESPEC261 262// DATE_AND_TIME (Fortran 2018 16.9.59)263 264// Helper to set an integer value to -HUGE265template <int KIND> struct StoreNegativeHugeAt {266 void operator()(267 const Fortran::runtime::Descriptor &result, std::size_t at) const {268 *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<269 Fortran::common::TypeCategory::Integer, KIND>>(at) =270 -std::numeric_limits<Fortran::runtime::CppTypeFor<271 Fortran::common::TypeCategory::Integer, KIND>>::max();272 }273};274 275// Default implementation when date and time information is not available (set276// strings to blanks and values to -HUGE as defined by the standard).277static void DateAndTimeUnavailable(Fortran::runtime::Terminator &terminator,278 char *date, std::size_t dateChars, char *time, std::size_t timeChars,279 char *zone, std::size_t zoneChars,280 const Fortran::runtime::Descriptor *values) {281 if (date) {282 runtime::memset(date, static_cast<int>(' '), dateChars);283 }284 if (time) {285 runtime::memset(time, static_cast<int>(' '), timeChars);286 }287 if (zone) {288 runtime::memset(zone, static_cast<int>(' '), zoneChars);289 }290 if (values) {291 auto typeCode{values->type().GetCategoryAndKind()};292 RUNTIME_CHECK(terminator,293 values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&294 typeCode &&295 typeCode->first == Fortran::common::TypeCategory::Integer);296 // DATE_AND_TIME values argument must have decimal range > 4. Do not accept297 // KIND 1 here.298 int kind{typeCode->second};299 RUNTIME_CHECK(terminator, kind != 1);300 for (std::size_t i = 0; i < 8; ++i) {301 Fortran::runtime::ApplyIntegerKind<StoreNegativeHugeAt, void>(302 kind, terminator, *values, i);303 }304 }305}306 307#ifndef _WIN32308#ifdef _AIX309// Compute the time difference from GMT/UTC to get around the behavior of310// strfname on AIX that requires setting an environment variable for numeric311// value for ZONE.312// The ZONE and the VALUES(4) arguments of the DATE_AND_TIME intrinsic has313// the resolution to the minute.314static int computeUTCDiff(const tm &localTime, bool *err) {315 tm utcTime;316 const time_t timer{mktime(const_cast<tm *>(&localTime))};317 if (timer < 0) {318 *err = true;319 return 0;320 }321 322 // Get the GMT/UTC time323 if (gmtime_r(&timer, &utcTime) == nullptr) {324 *err = true;325 return 0;326 }327 328 // Adjust for day difference329 auto dayDiff{localTime.tm_mday - utcTime.tm_mday};330 auto localHr{localTime.tm_hour};331 if (dayDiff > 0) {332 if (dayDiff == 1) {333 localHr += 24;334 } else {335 utcTime.tm_hour += 24;336 }337 } else if (dayDiff < 0) {338 if (dayDiff == -1) {339 utcTime.tm_hour += 24;340 } else {341 localHr += 24;342 }343 }344 return (localHr * 60 + localTime.tm_min) -345 (utcTime.tm_hour * 60 + utcTime.tm_min);346}347#endif348 349static std::size_t getUTCOffsetToBuffer(350 char *buffer, const std::size_t &buffSize, tm *localTime) {351#ifdef _AIX352 // format: +HHMM or -HHMM353 bool err{false};354 auto utcOffset{computeUTCDiff(*localTime, &err)};355 auto hour{utcOffset / 60};356 auto hrMin{hour * 100 + (utcOffset - hour * 60)};357 auto n{sprintf(buffer, "%+05d", hrMin)};358 return err ? 0 : n + 1;359#else360 return std::strftime(buffer, buffSize, "%z", localTime);361#endif362}363 364// SFINAE helper to return the struct tm.tm_gmtoff which is not a POSIX standard365// field.366template <int KIND, typename TM = struct tm>367Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>368GetGmtOffset(const TM &tm, preferred_implementation,369 decltype(tm.tm_gmtoff) *Enabled = nullptr) {370 // Returns the GMT offset in minutes.371 return tm.tm_gmtoff / 60;372}373template <int KIND, typename TM = struct tm>374Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>375GetGmtOffset(const TM &tm, fallback_implementation) {376 // tm.tm_gmtoff is not available, there may be platform dependent alternatives377 // (such as using timezone from <time.h> when available), but so far just378 // return -HUGE to report that this information is not available.379 const auto negHuge{-std::numeric_limits<Fortran::runtime::CppTypeFor<380 Fortran::common::TypeCategory::Integer, KIND>>::max()};381#ifdef _AIX382 bool err{false};383 auto diff{computeUTCDiff(tm, &err)};384 if (err) {385 return negHuge;386 } else {387 return diff;388 }389#else390 return negHuge;391#endif392}393template <typename TM = struct tm> struct GmtOffsetHelper {394 template <int KIND> struct StoreGmtOffset {395 void operator()(const Fortran::runtime::Descriptor &result, std::size_t at,396 TM &tm) const {397 *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<398 Fortran::common::TypeCategory::Integer, KIND>>(at) =399 GetGmtOffset<KIND>(tm, 0);400 }401 };402};403 404// Dispatch to posix implementation where gettimeofday and localtime_r are405// available.406static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,407 std::size_t dateChars, char *time, std::size_t timeChars, char *zone,408 std::size_t zoneChars, const Fortran::runtime::Descriptor *values) {409 410 timeval t;411 if (gettimeofday(&t, nullptr) != 0) {412 DateAndTimeUnavailable(413 terminator, date, dateChars, time, timeChars, zone, zoneChars, values);414 return;415 }416 time_t timer{t.tv_sec};417 tm localTime;418 localtime_r(&timer, &localTime);419 std::intmax_t ms{t.tv_usec / 1000};420 421 static constexpr std::size_t buffSize{16};422 char buffer[buffSize];423 auto copyBufferAndPad{424 [&](char *dest, std::size_t destChars, std::size_t len) {425 auto copyLen{std::min(len, destChars)};426 runtime::memcpy(dest, buffer, copyLen);427 for (auto i{copyLen}; i < destChars; ++i) {428 dest[i] = ' ';429 }430 }};431 if (date) {432 auto len = std::strftime(buffer, buffSize, "%Y%m%d", &localTime);433 copyBufferAndPad(date, dateChars, len);434 }435 if (time) {436 auto len{std::snprintf(buffer, buffSize, "%02d%02d%02d.%03jd",437 localTime.tm_hour, localTime.tm_min, localTime.tm_sec, ms)};438 copyBufferAndPad(time, timeChars, len);439 }440 if (zone) {441 // Note: this may leave the buffer empty on many platforms. Classic flang442 // has a much more complex way of doing this (see __io_timezone in classic443 // flang).444 auto len{getUTCOffsetToBuffer(buffer, buffSize, &localTime)};445 copyBufferAndPad(zone, zoneChars, len);446 }447 if (values) {448 auto typeCode{values->type().GetCategoryAndKind()};449 RUNTIME_CHECK(terminator,450 values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&451 typeCode &&452 typeCode->first == Fortran::common::TypeCategory::Integer);453 // DATE_AND_TIME values argument must have decimal range > 4. Do not accept454 // KIND 1 here.455 int kind{typeCode->second};456 RUNTIME_CHECK(terminator, kind != 1);457 auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) {458 Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt,459 void>(kind, terminator, *values, atIndex, value);460 };461 storeIntegerAt(0, localTime.tm_year + 1900);462 storeIntegerAt(1, localTime.tm_mon + 1);463 storeIntegerAt(2, localTime.tm_mday);464 Fortran::runtime::ApplyIntegerKind<465 GmtOffsetHelper<struct tm>::StoreGmtOffset, void>(466 kind, terminator, *values, 3, localTime);467 storeIntegerAt(4, localTime.tm_hour);468 storeIntegerAt(5, localTime.tm_min);469 storeIntegerAt(6, localTime.tm_sec);470 storeIntegerAt(7, ms);471 }472}473 474#else475// Fallback implementation where gettimeofday or localtime_r are not both476// available (e.g. windows).477static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,478 std::size_t dateChars, char *time, std::size_t timeChars, char *zone,479 std::size_t zoneChars, const Fortran::runtime::Descriptor *values) {480 // TODO: An actual implementation for non Posix system should be added.481 // So far, implement as if the date and time is not available on those482 // platforms.483 DateAndTimeUnavailable(484 terminator, date, dateChars, time, timeChars, zone, zoneChars, values);485}486#endif487} // namespace488 489namespace Fortran::runtime {490extern "C" {491 492double RTNAME(CpuTime)() { return GetCpuTime(0); }493 494std::int64_t RTNAME(SystemClockCount)(int kind) {495 return GetSystemClockCount(kind, 0);496}497 498std::int64_t RTNAME(SystemClockCountRate)(int kind) {499 return GetSystemClockCountRate(kind, 0);500}501 502std::int64_t RTNAME(SystemClockCountMax)(int kind) {503 return GetSystemClockCountMax(kind, 0);504}505 506void RTNAME(DateAndTime)(char *date, std::size_t dateChars, char *time,507 std::size_t timeChars, char *zone, std::size_t zoneChars,508 const char *source, int line, const Descriptor *values) {509 Fortran::runtime::Terminator terminator{source, line};510 return GetDateAndTime(511 terminator, date, dateChars, time, timeChars, zone, zoneChars, values);512}513 514void RTNAME(Etime)(const Descriptor *values, const Descriptor *time,515 const char *sourceFile, int line) {516 Fortran::runtime::Terminator terminator{sourceFile, line};517 518 double usrTime = -1.0, sysTime = -1.0, realTime = -1.0;519 520#ifdef _WIN32521 FILETIME creationTime;522 FILETIME exitTime;523 FILETIME kernelTime;524 FILETIME userTime;525 526 if (GetProcessTimes(GetCurrentProcess(), &creationTime, &exitTime,527 &kernelTime, &userTime) == 0) {528 ULARGE_INTEGER userSystemTime;529 ULARGE_INTEGER kernelSystemTime;530 531 runtime::memcpy(&userSystemTime, &userTime, sizeof(FILETIME));532 runtime::memcpy(&kernelSystemTime, &kernelTime, sizeof(FILETIME));533 534 usrTime = ((double)(userSystemTime.QuadPart)) / 10000000.0;535 sysTime = ((double)(kernelSystemTime.QuadPart)) / 10000000.0;536 realTime = usrTime + sysTime;537 }538#else539 struct tms tms;540 if (times(&tms) != (clock_t)-1) {541 usrTime = ((double)(tms.tms_utime)) / sysconf(_SC_CLK_TCK);542 sysTime = ((double)(tms.tms_stime)) / sysconf(_SC_CLK_TCK);543 realTime = usrTime + sysTime;544 }545#endif546 547 if (values) {548 auto typeCode{values->type().GetCategoryAndKind()};549 // ETIME values argument must have decimal range == 2.550 RUNTIME_CHECK(terminator,551 values->rank() == 1 && typeCode &&552 typeCode->first == Fortran::common::TypeCategory::Real);553 // Only accept KIND=4 here.554 int kind{typeCode->second};555 RUNTIME_CHECK(terminator, kind == 4);556 auto extent{values->GetDimension(0).Extent()};557 if (extent >= 1) {558 ApplyFloatingPointKind<StoreFloatingPointAt, void>(559 kind, terminator, *values, /* atIndex = */ 0, usrTime);560 }561 if (extent >= 2) {562 ApplyFloatingPointKind<StoreFloatingPointAt, void>(563 kind, terminator, *values, /* atIndex = */ 1, sysTime);564 }565 }566 567 if (time) {568 auto typeCode{time->type().GetCategoryAndKind()};569 // ETIME time argument must have decimal range == 0.570 RUNTIME_CHECK(terminator,571 time->rank() == 0 && typeCode &&572 typeCode->first == Fortran::common::TypeCategory::Real);573 // Only accept KIND=4 here.574 int kind{typeCode->second};575 RUNTIME_CHECK(terminator, kind == 4);576 577 ApplyFloatingPointKind<StoreFloatingPointAt, void>(578 kind, terminator, *time, /* atIndex = */ 0, realTime);579 }580}581 582} // extern "C"583} // namespace Fortran::runtime584