| 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-exception |
| 6 | // |
| 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 _WIN32 |
| 23 | #include "flang/Common/windows-include.h" |
| 24 | #else |
| 25 | #include <sys/time.h> // gettimeofday |
| 26 | #include <sys/times.h> |
| 27 | #include <unistd.h> |
| 28 | #endif |
| 29 | |
| 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 implementation |
| 34 | // that should be available everywhere. This may not provide the best resolution |
| 35 | // and is particularly troublesome on (some?) POSIX systems where CLOCKS_PER_SEC |
| 36 | // is defined as 10^6 regardless of the actual precision of std::clock(). |
| 37 | // Therefore, we will usually prefer platform-specific alternatives when they |
| 38 | // are available. |
| 39 | // |
| 40 | // We can use SFINAE to choose a platform-specific alternative. To do so, we |
| 41 | // introduce a helper function template, whose overload set will contain only |
| 42 | // implementations relying on interfaces which are actually available. Each |
| 43 | // overload will have a dummy parameter whose type indicates whether or not it |
| 44 | // should be preferred. Any other parameters required for SFINAE should have |
| 45 | // default values provided. |
| 46 | namespace { |
| 47 | // Types for the dummy parameter indicating the priority of a given overload. |
| 48 | // We will invoke our helper with an integer literal argument, so the overload |
| 49 | // with the highest priority should have the type int. |
| 50 | using fallback_implementation = double; |
| 51 | using preferred_implementation = int; |
| 52 | |
| 53 | // This is the fallback implementation, which should work everywhere. |
| 54 | template <typename Unused = void> double GetCpuTime(fallback_implementation) { |
| 55 | std::clock_t timestamp{std::clock()}; |
| 56 | if (timestamp != static_cast<std::clock_t>(-1)) { |
| 57 | return static_cast<double>(timestamp) / CLOCKS_PER_SEC; |
| 58 | } |
| 59 | // Return some negative value to represent failure. |
| 60 | return -1.0; |
| 61 | } |
| 62 | |
| 63 | // struct timespec and timespec_get are not implemented in macOS 10.14. Using |
| 64 | // it here limits which version of MacOS we are compatible with. Unfortunately |
| 65 | // when building on newer MacOS for older MacOS it uses the new headers (with |
| 66 | // a definition of struct timespec) but just errors on API calls so we can't use |
| 67 | // overloading magic to trigger different implementations depending if struct |
| 68 | // timespec is defined. |
| 69 | #if defined __APPLE__ |
| 70 | #define NO_TIMESPEC |
| 71 | #else |
| 72 | #undef NO_TIMESPEC |
| 73 | #endif |
| 74 | |
| 75 | #if defined __MINGW32__ |
| 76 | // clock_gettime is implemented in the pthread library for MinGW. |
| 77 | // Using it here would mean that all programs that link libflang_rt are |
| 78 | // required to also link to pthread. Instead, don't use the function. |
| 79 | #undef CLOCKID_CPU_TIME |
| 80 | #undef CLOCKID_ELAPSED_TIME |
| 81 | #else |
| 82 | // Determine what clock to use for CPU time. |
| 83 | #if defined CLOCK_PROCESS_CPUTIME_ID |
| 84 | #define CLOCKID_CPU_TIME CLOCK_PROCESS_CPUTIME_ID |
| 85 | #elif defined CLOCK_THREAD_CPUTIME_ID |
| 86 | #define CLOCKID_CPU_TIME CLOCK_THREAD_CPUTIME_ID |
| 87 | #else |
| 88 | #undef CLOCKID_CPU_TIME |
| 89 | #endif |
| 90 | |
| 91 | // Determine what clock to use for elapsed time. |
| 92 | #if defined CLOCK_MONOTONIC |
| 93 | #define CLOCKID_ELAPSED_TIME CLOCK_MONOTONIC |
| 94 | #elif defined CLOCK_REALTIME |
| 95 | #define CLOCKID_ELAPSED_TIME CLOCK_REALTIME |
| 96 | #else |
| 97 | #undef CLOCKID_ELAPSED_TIME |
| 98 | #endif |
| 99 | #endif |
| 100 | |
| 101 | #ifdef CLOCKID_CPU_TIME |
| 102 | #ifndef NO_TIMESPEC |
| 103 | // POSIX implementation using clock_gettime. This is only enabled where |
| 104 | // clock_gettime is available. |
| 105 | template <typename T = int, typename U = struct timespec> |
| 106 | double GetCpuTime(preferred_implementation, |
| 107 | // We need some dummy parameters to pass to decltype(clock_gettime). |
| 108 | T ClockId = 0, U *Timespec = nullptr, |
| 109 | decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) { |
| 110 | struct timespec tspec; |
| 111 | if (clock_gettime(CLOCKID_CPU_TIME, tp: &tspec) == 0) { |
| 112 | return tspec.tv_nsec * 1.0e-9 + tspec.tv_sec; |
| 113 | } |
| 114 | // Return some negative value to represent failure. |
| 115 | return -1.0; |
| 116 | } |
| 117 | #endif // !NO_TIMESPEC |
| 118 | #endif // CLOCKID_CPU_TIME |
| 119 | |
| 120 | using count_t = std::int64_t; |
| 121 | using unsigned_count_t = std::uint64_t; |
| 122 | |
| 123 | // POSIX implementation using clock_gettime where available. The clock_gettime |
| 124 | // result is in nanoseconds, which is converted as necessary to |
| 125 | // - deciseconds for kind 1 |
| 126 | // - milliseconds for kinds 2, 4 |
| 127 | // - nanoseconds for kinds 8, 16 |
| 128 | constexpr unsigned_count_t DS_PER_SEC{10u}; |
| 129 | constexpr unsigned_count_t MS_PER_SEC{1'000u}; |
| 130 | [[maybe_unused]] constexpr unsigned_count_t US_PER_SEC{1'000'000u}; |
| 131 | constexpr unsigned_count_t NS_PER_SEC{1'000'000'000u}; |
| 132 | |
| 133 | // Computes HUGE(INT(0,kind)) as an unsigned integer value. |
| 134 | static constexpr inline unsigned_count_t GetHUGE(int kind) { |
| 135 | if (kind > 8) { |
| 136 | kind = 8; |
| 137 | } |
| 138 | return (unsigned_count_t{1} << ((8 * kind) - 1)) - 1; |
| 139 | } |
| 140 | |
| 141 | count_t ConvertSecondsNanosecondsToCount( |
| 142 | int kind, unsigned_count_t sec, unsigned_count_t nsec) { |
| 143 | const unsigned_count_t huge{GetHUGE(kind)}; |
| 144 | if (kind >= 8) { |
| 145 | return (sec * NS_PER_SEC + nsec) % (huge + 1); |
| 146 | } else if (kind >= 2) { |
| 147 | return (sec * MS_PER_SEC + (nsec / (NS_PER_SEC / MS_PER_SEC))) % (huge + 1); |
| 148 | } else { // kind == 1 |
| 149 | return (sec * DS_PER_SEC + (nsec / (NS_PER_SEC / DS_PER_SEC))) % (huge + 1); |
| 150 | } |
| 151 | } |
| 152 | |
| 153 | // Less accurate implementation only accurate to the nearest microsecond |
| 154 | // (instead of nanosecond) for systems where `struct timespec` is not available. |
| 155 | #if defined(NO_TIMESPEC) && !defined(_WIN32) |
| 156 | // Function converts a struct timeval into the desired count to |
| 157 | // be returned by the timing functions in accordance with the requested |
| 158 | // kind at the call site. |
| 159 | count_t ConvertTimevalToCount(int kind, const struct timeval &tval) { |
| 160 | unsigned_count_t sec{static_cast<unsigned_count_t>(tval.tv_sec)}; |
| 161 | unsigned_count_t nsec{static_cast<unsigned_count_t>(tval.tv_usec) * 1000}; |
| 162 | return ConvertSecondsNanosecondsToCount(kind, sec, nsec); |
| 163 | } |
| 164 | |
| 165 | template <typename Unused = void> |
| 166 | count_t GetSystemClockCount(int kind, fallback_implementation) { |
| 167 | struct timeval tval; |
| 168 | |
| 169 | if (gettimeofday(&tval, /*timezone=*/nullptr) != 0) { |
| 170 | // Return -HUGE(COUNT) to represent failure. |
| 171 | return -static_cast<count_t>(GetHUGE(kind)); |
| 172 | } |
| 173 | |
| 174 | // Compute the timestamp as seconds plus nanoseconds in accordance |
| 175 | // with the requested kind at the call site. |
| 176 | return ConvertTimevalToCount(kind, tval); |
| 177 | } |
| 178 | |
| 179 | #else |
| 180 | |
| 181 | // Function converts a std::timespec_t into the desired count to |
| 182 | // be returned by the timing functions in accordance with the requested |
| 183 | // kind at the call site. |
| 184 | count_t ConvertTimeSpecToCount(int kind, const struct timespec &tspec) { |
| 185 | unsigned_count_t sec{static_cast<unsigned_count_t>(tspec.tv_sec)}; |
| 186 | unsigned_count_t nsec{static_cast<unsigned_count_t>(tspec.tv_nsec)}; |
| 187 | return ConvertSecondsNanosecondsToCount(kind, sec, nsec); |
| 188 | } |
| 189 | |
| 190 | #ifndef _AIX |
| 191 | // More accurate version with nanosecond accuracy |
| 192 | template <typename Unused = void> |
| 193 | count_t GetSystemClockCount(int kind, fallback_implementation) { |
| 194 | struct timespec tspec; |
| 195 | |
| 196 | if (timespec_get(ts: &tspec, TIME_UTC) < 0) { |
| 197 | // Return -HUGE(COUNT) to represent failure. |
| 198 | return -static_cast<count_t>(GetHUGE(kind)); |
| 199 | } |
| 200 | |
| 201 | // Compute the timestamp as seconds plus nanoseconds in accordance |
| 202 | // with the requested kind at the call site. |
| 203 | return ConvertTimeSpecToCount(kind, tspec); |
| 204 | } |
| 205 | #endif // !_AIX |
| 206 | #endif // !NO_TIMESPEC |
| 207 | |
| 208 | template <typename Unused = void> |
| 209 | count_t GetSystemClockCountRate(int kind, fallback_implementation) { |
| 210 | #ifdef NO_TIMESPEC |
| 211 | return kind >= 8 ? US_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC; |
| 212 | #else |
| 213 | return kind >= 8 ? NS_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC; |
| 214 | #endif |
| 215 | } |
| 216 | |
| 217 | template <typename Unused = void> |
| 218 | count_t GetSystemClockCountMax(int kind, fallback_implementation) { |
| 219 | unsigned_count_t maxCount{GetHUGE(kind)}; |
| 220 | return maxCount; |
| 221 | } |
| 222 | |
| 223 | #ifndef NO_TIMESPEC |
| 224 | #ifdef CLOCKID_ELAPSED_TIME |
| 225 | template <typename T = int, typename U = struct timespec> |
| 226 | count_t GetSystemClockCount(int kind, preferred_implementation, |
| 227 | // We need some dummy parameters to pass to decltype(clock_gettime). |
| 228 | T ClockId = 0, U *Timespec = nullptr, |
| 229 | decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) { |
| 230 | struct timespec tspec; |
| 231 | const unsigned_count_t huge{GetHUGE(kind)}; |
| 232 | if (clock_gettime(CLOCKID_ELAPSED_TIME, tp: &tspec) != 0) { |
| 233 | return -huge; // failure |
| 234 | } |
| 235 | |
| 236 | // Compute the timestamp as seconds plus nanoseconds in accordance |
| 237 | // with the requested kind at the call site. |
| 238 | return ConvertTimeSpecToCount(kind, tspec); |
| 239 | } |
| 240 | #endif // CLOCKID_ELAPSED_TIME |
| 241 | |
| 242 | template <typename T = int, typename U = struct timespec> |
| 243 | count_t GetSystemClockCountRate(int kind, preferred_implementation, |
| 244 | // We need some dummy parameters to pass to decltype(clock_gettime). |
| 245 | T ClockId = 0, U *Timespec = nullptr, |
| 246 | decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) { |
| 247 | return kind >= 8 ? NS_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC; |
| 248 | } |
| 249 | |
| 250 | template <typename T = int, typename U = struct timespec> |
| 251 | count_t GetSystemClockCountMax(int kind, preferred_implementation, |
| 252 | // We need some dummy parameters to pass to decltype(clock_gettime). |
| 253 | T ClockId = 0, U *Timespec = nullptr, |
| 254 | decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) { |
| 255 | return GetHUGE(kind); |
| 256 | } |
| 257 | #endif // !NO_TIMESPEC |
| 258 | |
| 259 | // DATE_AND_TIME (Fortran 2018 16.9.59) |
| 260 | |
| 261 | // Helper to set an integer value to -HUGE |
| 262 | template <int KIND> struct StoreNegativeHugeAt { |
| 263 | void operator()( |
| 264 | const Fortran::runtime::Descriptor &result, std::size_t at) const { |
| 265 | *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor< |
| 266 | Fortran::common::TypeCategory::Integer, KIND>>(at) = |
| 267 | -std::numeric_limits<Fortran::runtime::CppTypeFor< |
| 268 | Fortran::common::TypeCategory::Integer, KIND>>::max(); |
| 269 | } |
| 270 | }; |
| 271 | |
| 272 | // Default implementation when date and time information is not available (set |
| 273 | // strings to blanks and values to -HUGE as defined by the standard). |
| 274 | static void DateAndTimeUnavailable(Fortran::runtime::Terminator &terminator, |
| 275 | char *date, std::size_t dateChars, char *time, std::size_t timeChars, |
| 276 | char *zone, std::size_t zoneChars, |
| 277 | const Fortran::runtime::Descriptor *values) { |
| 278 | if (date) { |
| 279 | std::memset(s: date, c: static_cast<int>(' '), n: dateChars); |
| 280 | } |
| 281 | if (time) { |
| 282 | std::memset(s: time, c: static_cast<int>(' '), n: timeChars); |
| 283 | } |
| 284 | if (zone) { |
| 285 | std::memset(s: zone, c: static_cast<int>(' '), n: zoneChars); |
| 286 | } |
| 287 | if (values) { |
| 288 | auto typeCode{values->type().GetCategoryAndKind()}; |
| 289 | RUNTIME_CHECK(terminator, |
| 290 | values->rank() == 1 && values->GetDimension(0).Extent() >= 8 && |
| 291 | typeCode && |
| 292 | typeCode->first == Fortran::common::TypeCategory::Integer); |
| 293 | // DATE_AND_TIME values argument must have decimal range > 4. Do not accept |
| 294 | // KIND 1 here. |
| 295 | int kind{typeCode->second}; |
| 296 | RUNTIME_CHECK(terminator, kind != 1); |
| 297 | for (std::size_t i = 0; i < 8; ++i) { |
| 298 | Fortran::runtime::ApplyIntegerKind<StoreNegativeHugeAt, void>( |
| 299 | kind, terminator, *values, i); |
| 300 | } |
| 301 | } |
| 302 | } |
| 303 | |
| 304 | #ifndef _WIN32 |
| 305 | #ifdef _AIX |
| 306 | // Compute the time difference from GMT/UTC to get around the behavior of |
| 307 | // strfname on AIX that requires setting an environment variable for numeric |
| 308 | // value for ZONE. |
| 309 | // The ZONE and the VALUES(4) arguments of the DATE_AND_TIME intrinsic has |
| 310 | // the resolution to the minute. |
| 311 | static int computeUTCDiff(const tm &localTime, bool *err) { |
| 312 | tm utcTime; |
| 313 | const time_t timer{mktime(const_cast<tm *>(&localTime))}; |
| 314 | if (timer < 0) { |
| 315 | *err = true; |
| 316 | return 0; |
| 317 | } |
| 318 | |
| 319 | // Get the GMT/UTC time |
| 320 | if (gmtime_r(&timer, &utcTime) == nullptr) { |
| 321 | *err = true; |
| 322 | return 0; |
| 323 | } |
| 324 | |
| 325 | // Adjust for day difference |
| 326 | auto dayDiff{localTime.tm_mday - utcTime.tm_mday}; |
| 327 | auto localHr{localTime.tm_hour}; |
| 328 | if (dayDiff > 0) { |
| 329 | if (dayDiff == 1) { |
| 330 | localHr += 24; |
| 331 | } else { |
| 332 | utcTime.tm_hour += 24; |
| 333 | } |
| 334 | } else if (dayDiff < 0) { |
| 335 | if (dayDiff == -1) { |
| 336 | utcTime.tm_hour += 24; |
| 337 | } else { |
| 338 | localHr += 24; |
| 339 | } |
| 340 | } |
| 341 | return (localHr * 60 + localTime.tm_min) - |
| 342 | (utcTime.tm_hour * 60 + utcTime.tm_min); |
| 343 | } |
| 344 | #endif |
| 345 | |
| 346 | static std::size_t getUTCOffsetToBuffer( |
| 347 | char *buffer, const std::size_t &buffSize, tm *localTime) { |
| 348 | #ifdef _AIX |
| 349 | // format: +HHMM or -HHMM |
| 350 | bool err{false}; |
| 351 | auto utcOffset{computeUTCDiff(*localTime, &err)}; |
| 352 | auto hour{utcOffset / 60}; |
| 353 | auto hrMin{hour * 100 + (utcOffset - hour * 60)}; |
| 354 | auto n{sprintf(buffer, "%+05d" , hrMin)}; |
| 355 | return err ? 0 : n + 1; |
| 356 | #else |
| 357 | return std::strftime(s: buffer, maxsize: buffSize, format: "%z" , tp: localTime); |
| 358 | #endif |
| 359 | } |
| 360 | |
| 361 | // SFINAE helper to return the struct tm.tm_gmtoff which is not a POSIX standard |
| 362 | // field. |
| 363 | template <int KIND, typename TM = struct tm> |
| 364 | Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND> |
| 365 | GetGmtOffset(const TM &tm, preferred_implementation, |
| 366 | decltype(tm.tm_gmtoff) *Enabled = nullptr) { |
| 367 | // Returns the GMT offset in minutes. |
| 368 | return tm.tm_gmtoff / 60; |
| 369 | } |
| 370 | template <int KIND, typename TM = struct tm> |
| 371 | Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND> |
| 372 | GetGmtOffset(const TM &tm, fallback_implementation) { |
| 373 | // tm.tm_gmtoff is not available, there may be platform dependent alternatives |
| 374 | // (such as using timezone from <time.h> when available), but so far just |
| 375 | // return -HUGE to report that this information is not available. |
| 376 | const auto negHuge{-std::numeric_limits<Fortran::runtime::CppTypeFor< |
| 377 | Fortran::common::TypeCategory::Integer, KIND>>::max()}; |
| 378 | #ifdef _AIX |
| 379 | bool err{false}; |
| 380 | auto diff{computeUTCDiff(tm, &err)}; |
| 381 | if (err) { |
| 382 | return negHuge; |
| 383 | } else { |
| 384 | return diff; |
| 385 | } |
| 386 | #else |
| 387 | return negHuge; |
| 388 | #endif |
| 389 | } |
| 390 | template <typename TM = struct tm> struct GmtOffsetHelper { |
| 391 | template <int KIND> struct StoreGmtOffset { |
| 392 | void operator()(const Fortran::runtime::Descriptor &result, std::size_t at, |
| 393 | TM &tm) const { |
| 394 | *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor< |
| 395 | Fortran::common::TypeCategory::Integer, KIND>>(at) = |
| 396 | GetGmtOffset<KIND>(tm, 0); |
| 397 | } |
| 398 | }; |
| 399 | }; |
| 400 | |
| 401 | // Dispatch to posix implementation where gettimeofday and localtime_r are |
| 402 | // available. |
| 403 | static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date, |
| 404 | std::size_t dateChars, char *time, std::size_t timeChars, char *zone, |
| 405 | std::size_t zoneChars, const Fortran::runtime::Descriptor *values) { |
| 406 | |
| 407 | timeval t; |
| 408 | if (gettimeofday(tv: &t, tz: nullptr) != 0) { |
| 409 | DateAndTimeUnavailable( |
| 410 | terminator, date, dateChars, time, timeChars, zone, zoneChars, values); |
| 411 | return; |
| 412 | } |
| 413 | time_t timer{t.tv_sec}; |
| 414 | tm localTime; |
| 415 | localtime_r(timer: &timer, tp: &localTime); |
| 416 | std::intmax_t ms{t.tv_usec / 1000}; |
| 417 | |
| 418 | static constexpr std::size_t buffSize{16}; |
| 419 | char buffer[buffSize]; |
| 420 | auto copyBufferAndPad{ |
| 421 | [&](char *dest, std::size_t destChars, std::size_t len) { |
| 422 | auto copyLen{std::min(a: len, b: destChars)}; |
| 423 | std::memcpy(dest: dest, src: buffer, n: copyLen); |
| 424 | for (auto i{copyLen}; i < destChars; ++i) { |
| 425 | dest[i] = ' '; |
| 426 | } |
| 427 | }}; |
| 428 | if (date) { |
| 429 | auto len = std::strftime(s: buffer, maxsize: buffSize, format: "%Y%m%d" , tp: &localTime); |
| 430 | copyBufferAndPad(date, dateChars, len); |
| 431 | } |
| 432 | if (time) { |
| 433 | auto len{std::snprintf(s: buffer, maxlen: buffSize, format: "%02d%02d%02d.%03jd" , |
| 434 | localTime.tm_hour, localTime.tm_min, localTime.tm_sec, ms)}; |
| 435 | copyBufferAndPad(time, timeChars, len); |
| 436 | } |
| 437 | if (zone) { |
| 438 | // Note: this may leave the buffer empty on many platforms. Classic flang |
| 439 | // has a much more complex way of doing this (see __io_timezone in classic |
| 440 | // flang). |
| 441 | auto len{getUTCOffsetToBuffer(buffer, buffSize, localTime: &localTime)}; |
| 442 | copyBufferAndPad(zone, zoneChars, len); |
| 443 | } |
| 444 | if (values) { |
| 445 | auto typeCode{values->type().GetCategoryAndKind()}; |
| 446 | RUNTIME_CHECK(terminator, |
| 447 | values->rank() == 1 && values->GetDimension(0).Extent() >= 8 && |
| 448 | typeCode && |
| 449 | typeCode->first == Fortran::common::TypeCategory::Integer); |
| 450 | // DATE_AND_TIME values argument must have decimal range > 4. Do not accept |
| 451 | // KIND 1 here. |
| 452 | int kind{typeCode->second}; |
| 453 | RUNTIME_CHECK(terminator, kind != 1); |
| 454 | auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) { |
| 455 | Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, |
| 456 | void>(kind, terminator, *values, atIndex, value); |
| 457 | }; |
| 458 | storeIntegerAt(0, localTime.tm_year + 1900); |
| 459 | storeIntegerAt(1, localTime.tm_mon + 1); |
| 460 | storeIntegerAt(2, localTime.tm_mday); |
| 461 | Fortran::runtime::ApplyIntegerKind< |
| 462 | GmtOffsetHelper<struct tm>::StoreGmtOffset, void>( |
| 463 | kind, terminator, *values, 3, localTime); |
| 464 | storeIntegerAt(4, localTime.tm_hour); |
| 465 | storeIntegerAt(5, localTime.tm_min); |
| 466 | storeIntegerAt(6, localTime.tm_sec); |
| 467 | storeIntegerAt(7, ms); |
| 468 | } |
| 469 | } |
| 470 | |
| 471 | #else |
| 472 | // Fallback implementation where gettimeofday or localtime_r are not both |
| 473 | // available (e.g. windows). |
| 474 | static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date, |
| 475 | std::size_t dateChars, char *time, std::size_t timeChars, char *zone, |
| 476 | std::size_t zoneChars, const Fortran::runtime::Descriptor *values) { |
| 477 | // TODO: An actual implementation for non Posix system should be added. |
| 478 | // So far, implement as if the date and time is not available on those |
| 479 | // platforms. |
| 480 | DateAndTimeUnavailable( |
| 481 | terminator, date, dateChars, time, timeChars, zone, zoneChars, values); |
| 482 | } |
| 483 | #endif |
| 484 | } // namespace |
| 485 | |
| 486 | namespace Fortran::runtime { |
| 487 | extern "C" { |
| 488 | |
| 489 | double RTNAME(CpuTime)() { return GetCpuTime(0); } |
| 490 | |
| 491 | std::int64_t RTNAME(SystemClockCount)(int kind) { |
| 492 | return GetSystemClockCount(kind, 0); |
| 493 | } |
| 494 | |
| 495 | std::int64_t RTNAME(SystemClockCountRate)(int kind) { |
| 496 | return GetSystemClockCountRate(kind, 0); |
| 497 | } |
| 498 | |
| 499 | std::int64_t RTNAME(SystemClockCountMax)(int kind) { |
| 500 | return GetSystemClockCountMax(kind, 0); |
| 501 | } |
| 502 | |
| 503 | void RTNAME(DateAndTime)(char *date, std::size_t dateChars, char *time, |
| 504 | std::size_t timeChars, char *zone, std::size_t zoneChars, |
| 505 | const char *source, int line, const Descriptor *values) { |
| 506 | Fortran::runtime::Terminator terminator{source, line}; |
| 507 | return GetDateAndTime( |
| 508 | terminator, date, dateChars, time, timeChars, zone, zoneChars, values); |
| 509 | } |
| 510 | |
| 511 | void RTNAME(Etime)(const Descriptor *values, const Descriptor *time, |
| 512 | const char *sourceFile, int line) { |
| 513 | Fortran::runtime::Terminator terminator{sourceFile, line}; |
| 514 | |
| 515 | double usrTime = -1.0, sysTime = -1.0, realTime = -1.0; |
| 516 | |
| 517 | #ifdef _WIN32 |
| 518 | FILETIME creationTime; |
| 519 | FILETIME exitTime; |
| 520 | FILETIME kernelTime; |
| 521 | FILETIME userTime; |
| 522 | |
| 523 | if (GetProcessTimes(GetCurrentProcess(), &creationTime, &exitTime, |
| 524 | &kernelTime, &userTime) == 0) { |
| 525 | ULARGE_INTEGER userSystemTime; |
| 526 | ULARGE_INTEGER kernelSystemTime; |
| 527 | |
| 528 | memcpy(&userSystemTime, &userTime, sizeof(FILETIME)); |
| 529 | memcpy(&kernelSystemTime, &kernelTime, sizeof(FILETIME)); |
| 530 | |
| 531 | usrTime = ((double)(userSystemTime.QuadPart)) / 10000000.0; |
| 532 | sysTime = ((double)(kernelSystemTime.QuadPart)) / 10000000.0; |
| 533 | realTime = usrTime + sysTime; |
| 534 | } |
| 535 | #else |
| 536 | struct tms tms; |
| 537 | if (times(buffer: &tms) != (clock_t)-1) { |
| 538 | usrTime = ((double)(tms.tms_utime)) / sysconf(_SC_CLK_TCK); |
| 539 | sysTime = ((double)(tms.tms_stime)) / sysconf(_SC_CLK_TCK); |
| 540 | realTime = usrTime + sysTime; |
| 541 | } |
| 542 | #endif |
| 543 | |
| 544 | if (values) { |
| 545 | auto typeCode{values->type().GetCategoryAndKind()}; |
| 546 | // ETIME values argument must have decimal range == 2. |
| 547 | RUNTIME_CHECK(terminator, |
| 548 | values->rank() == 1 && typeCode && |
| 549 | typeCode->first == Fortran::common::TypeCategory::Real); |
| 550 | // Only accept KIND=4 here. |
| 551 | int kind{typeCode->second}; |
| 552 | RUNTIME_CHECK(terminator, kind == 4); |
| 553 | auto extent{values->GetDimension(0).Extent()}; |
| 554 | if (extent >= 1) { |
| 555 | ApplyFloatingPointKind<StoreFloatingPointAt, void>( |
| 556 | kind, terminator, *values, /* atIndex = */ 0, usrTime); |
| 557 | } |
| 558 | if (extent >= 2) { |
| 559 | ApplyFloatingPointKind<StoreFloatingPointAt, void>( |
| 560 | kind, terminator, *values, /* atIndex = */ 1, sysTime); |
| 561 | } |
| 562 | } |
| 563 | |
| 564 | if (time) { |
| 565 | auto typeCode{time->type().GetCategoryAndKind()}; |
| 566 | // ETIME time argument must have decimal range == 0. |
| 567 | RUNTIME_CHECK(terminator, |
| 568 | time->rank() == 0 && typeCode && |
| 569 | typeCode->first == Fortran::common::TypeCategory::Real); |
| 570 | // Only accept KIND=4 here. |
| 571 | int kind{typeCode->second}; |
| 572 | RUNTIME_CHECK(terminator, kind == 4); |
| 573 | |
| 574 | ApplyFloatingPointKind<StoreFloatingPointAt, void>( |
| 575 | kind, terminator, *time, /* atIndex = */ 0, realTime); |
| 576 | } |
| 577 | } |
| 578 | |
| 579 | } // extern "C" |
| 580 | } // namespace Fortran::runtime |
| 581 | |