flang/runtime/time-intrinsic.cpp

   1 //===-- runtime/time-intrinsic.cpp ----------------------------------------===//
   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 "terminator.h"
  13 #include "tools.h"
  14 #include "flang/Runtime/cpp-type.h"
  15 #include "flang/Runtime/descriptor.h"
  16 #include <algorithm>
  17 #include <cstdint>
  18 #include <cstdio>
  19 #include <cstdlib>
  20 #include <cstring>
  21 #include <ctime>
  22 #ifndef _WIN32
  23 #include <sys/time.h> // gettimeofday
  24 #endif
  25
  26 // CPU_TIME (Fortran 2018 16.9.57)
  27 // SYSTEM_CLOCK (Fortran 2018 16.9.168)
  28 //
  29 // We can use std::clock() from the <ctime> header as a fallback implementation
  30 // that should be available everywhere. This may not provide the best resolution
  31 // and is particularly troublesome on (some?) POSIX systems where CLOCKS_PER_SEC
  32 // is defined as 10^6 regardless of the actual precision of std::clock().
  33 // Therefore, we will usually prefer platform-specific alternatives when they
  34 // are available.
  35 //
  36 // We can use SFINAE to choose a platform-specific alternative. To do so, we
  37 // introduce a helper function template, whose overload set will contain only
  38 // implementations relying on interfaces which are actually available. Each
  39 // overload will have a dummy parameter whose type indicates whether or not it
  40 // should be preferred. Any other parameters required for SFINAE should have
  41 // default values provided.
  42 namespace {
  43 // Types for the dummy parameter indicating the priority of a given overload.
  44 // We will invoke our helper with an integer literal argument, so the overload
  45 // with the highest priority should have the type int.
  46 using fallback_implementation = double;
  47 using preferred_implementation = int;
  48
  49 // This is the fallback implementation, which should work everywhere.
  50 template <typename Unused = void> double GetCpuTime(fallback_implementation) {
  51   std::clock_t timestamp{std::clock()};
  52   if (timestamp != static_cast<std::clock_t>(-1)) {
  53     return static_cast<double>(timestamp) / CLOCKS_PER_SEC;
  54   }
  55   // Return some negative value to represent failure.
  56   return -1.0;
  57 }
  58
  59 #if defined CLOCK_PROCESS_CPUTIME_ID
  60 #define CLOCKID CLOCK_PROCESS_CPUTIME_ID
  61 #elif defined CLOCK_THREAD_CPUTIME_ID
  62 #define CLOCKID CLOCK_THREAD_CPUTIME_ID
  63 #elif defined CLOCK_MONOTONIC
  64 #define CLOCKID CLOCK_MONOTONIC
  65 #elif defined CLOCK_REALTIME
  66 #define CLOCKID CLOCK_REALTIME
  67 #else
  68 #undef CLOCKID
  69 #endif
  70
  71 #ifdef CLOCKID
  72 // POSIX implementation using clock_gettime. This is only enabled where
  73 // clock_gettime is available.
  74 template <typename T = int, typename U = struct timespec>
  75 double GetCpuTime(preferred_implementation,
  76     // We need some dummy parameters to pass to decltype(clock_gettime).
  77     T ClockId = 0, U *Timespec = nullptr,
  78     decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
  79   struct timespec tspec;
  80   if (clock_gettime(CLOCKID, &tspec) == 0) {
  81     return tspec.tv_nsec * 1.0e-9 + tspec.tv_sec;
  82   }
  83   // Return some negative value to represent failure.
  84   return -1.0;
  85 }
  86 #endif
  87
  88 using count_t = std::int64_t;
  89 using unsigned_count_t = std::uint64_t;
  90
  91 // Computes HUGE(INT(0,kind)) as an unsigned integer value.
  92 static constexpr inline unsigned_count_t GetHUGE(int kind) {
  93   if (kind > 8) {
  94     kind = 8;
  95   }
  96   return (unsigned_count_t{1} << ((8 * kind) - 1)) - 1;
  97 }
  98
  99 // This is the fallback implementation, which should work everywhere. Note that
 100 // in general we can't recover after std::clock has reached its maximum value.
 101 template <typename Unused = void>
 102 count_t GetSystemClockCount(int kind, fallback_implementation) {
 103   std::clock_t timestamp{std::clock()};
 104   if (timestamp == static_cast<std::clock_t>(-1)) {
 105     // Return -HUGE(COUNT) to represent failure.
 106     return -static_cast<count_t>(GetHUGE(kind));
 107   }
 108   // Convert the timestamp to std::uint64_t with wrap-around. The timestamp is
 109   // most likely a floating-point value (since C'11), so compute the modulus
 110   // carefully when one is required.
 111   constexpr auto maxUnsignedCount{std::numeric_limits<unsigned_count_t>::max()};
 112   if constexpr (std::numeric_limits<std::clock_t>::max() > maxUnsignedCount) {
 113     timestamp -= maxUnsignedCount * std::floor(timestamp / maxUnsignedCount);
 114   }
 115   unsigned_count_t unsignedCount{static_cast<unsigned_count_t>(timestamp)};
 116   // Return the modulus of the unsigned integral count with HUGE(COUNT)+1.
 117   // The result is a signed integer but never negative.
 118   return static_cast<count_t>(unsignedCount % (GetHUGE(kind) + 1));
 119 }
 120
 121 template <typename Unused = void>
 122 count_t GetSystemClockCountRate(int kind, fallback_implementation) {
 123   return CLOCKS_PER_SEC;
 124 }
 125
 126 template <typename Unused = void>
 127 count_t GetSystemClockCountMax(int kind, fallback_implementation) {
 128   constexpr auto max_clock_t{std::numeric_limits<std::clock_t>::max()};
 129   unsigned_count_t maxCount{GetHUGE(kind)};
 130   return max_clock_t <= maxCount ? static_cast<count_t>(max_clock_t)
 131                                  : static_cast<count_t>(maxCount);
 132 }
 133
 134 // POSIX implementation using clock_gettime where available.  The clock_gettime
 135 // result is in nanoseconds, which is converted as necessary to
 136 //  - deciseconds for kind 1
 137 //  - milliseconds for kinds 2, 4
 138 //  - nanoseconds for kinds 8, 16
 139 constexpr unsigned_count_t DS_PER_SEC{10u};
 140 constexpr unsigned_count_t MS_PER_SEC{1'000u};
 141 constexpr unsigned_count_t NS_PER_SEC{1'000'000'000u};
 142
 143 #ifdef CLOCKID
 144 template <typename T = int, typename U = struct timespec>
 145 count_t GetSystemClockCount(int kind, preferred_implementation,
 146     // We need some dummy parameters to pass to decltype(clock_gettime).
 147     T ClockId = 0, U *Timespec = nullptr,
 148     decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
 149   struct timespec tspec;
 150   const unsigned_count_t huge{GetHUGE(kind)};
 151   if (clock_gettime(CLOCKID, &tspec) != 0) {
 152     return -huge; // failure
 153   }
 154   unsigned_count_t sec{static_cast<unsigned_count_t>(tspec.tv_sec)};
 155   unsigned_count_t nsec{static_cast<unsigned_count_t>(tspec.tv_nsec)};
 156   if (kind >= 8) {
 157     return (sec * NS_PER_SEC + nsec) % (huge + 1);
 158   } else if (kind >= 2) {
 159     return (sec * MS_PER_SEC + (nsec / (NS_PER_SEC / MS_PER_SEC))) % (huge + 1);
 160   } else { // kind == 1
 161     return (sec * DS_PER_SEC + (nsec / (NS_PER_SEC / DS_PER_SEC))) % (huge + 1);
 162   }
 163 }
 164 #endif
 165
 166 template <typename T = int, typename U = struct timespec>
 167 count_t GetSystemClockCountRate(int kind, preferred_implementation,
 168     // We need some dummy parameters to pass to decltype(clock_gettime).
 169     T ClockId = 0, U *Timespec = nullptr,
 170     decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
 171   return kind >= 8 ? NS_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC;
 172 }
 173
 174 template <typename T = int, typename U = struct timespec>
 175 count_t GetSystemClockCountMax(int kind, preferred_implementation,
 176     // We need some dummy parameters to pass to decltype(clock_gettime).
 177     T ClockId = 0, U *Timespec = nullptr,
 178     decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
 179   return GetHUGE(kind);
 180 }
 181
 182 // DATE_AND_TIME (Fortran 2018 16.9.59)
 183
 184 // Helper to set an integer value to -HUGE
 185 template <int KIND> struct StoreNegativeHugeAt {
 186   void operator()(
 187       const Fortran::runtime::Descriptor &result, std::size_t at) const {
 188     *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
 189         Fortran::common::TypeCategory::Integer, KIND>>(at) =
 190         -std::numeric_limits<Fortran::runtime::CppTypeFor<
 191             Fortran::common::TypeCategory::Integer, KIND>>::max();
 192   }
 193 };
 194
 195 // Default implementation when date and time information is not available (set
 196 // strings to blanks and values to -HUGE as defined by the standard).
 197 static void DateAndTimeUnavailable(Fortran::runtime::Terminator &terminator,
 198     char *date, std::size_t dateChars, char *time, std::size_t timeChars,
 199     char *zone, std::size_t zoneChars,
 200     const Fortran::runtime::Descriptor *values) {
 201   if (date) {
 202     std::memset(date, static_cast<int>(' '), dateChars);
 203   }
 204   if (time) {
 205     std::memset(time, static_cast<int>(' '), timeChars);
 206   }
 207   if (zone) {
 208     std::memset(zone, static_cast<int>(' '), zoneChars);
 209   }
 210   if (values) {
 211     auto typeCode{values->type().GetCategoryAndKind()};
 212     RUNTIME_CHECK(terminator,
 213         values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
 214             typeCode &&
 215             typeCode->first == Fortran::common::TypeCategory::Integer);
 216     // DATE_AND_TIME values argument must have decimal range > 4. Do not accept
 217     // KIND 1 here.
 218     int kind{typeCode->second};
 219     RUNTIME_CHECK(terminator, kind != 1);
 220     for (std::size_t i = 0; i < 8; ++i) {
 221       Fortran::runtime::ApplyIntegerKind<StoreNegativeHugeAt, void>(
 222           kind, terminator, *values, i);
 223     }
 224   }
 225 }
 226
 227 #ifndef _WIN32
 228
 229 // SFINAE helper to return the struct tm.tm_gmtoff which is not a POSIX standard
 230 // field.
 231 template <int KIND, typename TM = struct tm>
 232 Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>
 233 GetGmtOffset(const TM &tm, preferred_implementation,
 234     decltype(tm.tm_gmtoff) *Enabled = nullptr) {
 235   // Returns the GMT offset in minutes.
 236   return tm.tm_gmtoff / 60;
 237 }
 238 template <int KIND, typename TM = struct tm>
 239 Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>
 240 GetGmtOffset(const TM &tm, fallback_implementation) {
 241   // tm.tm_gmtoff is not available, there may be platform dependent alternatives
 242   // (such as using timezone from <time.h> when available), but so far just
 243   // return -HUGE to report that this information is not available.
 244   return -std::numeric_limits<Fortran::runtime::CppTypeFor<
 245       Fortran::common::TypeCategory::Integer, KIND>>::max();
 246 }
 247 template <typename TM = struct tm> struct GmtOffsetHelper {
 248   template <int KIND> struct StoreGmtOffset {
 249     void operator()(const Fortran::runtime::Descriptor &result, std::size_t at,
 250         TM &tm) const {
 251       *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
 252           Fortran::common::TypeCategory::Integer, KIND>>(at) =
 253           GetGmtOffset<KIND>(tm, 0);
 254     }
 255   };
 256 };
 257
 258 // Dispatch to posix implementation where gettimeofday and localtime_r are
 259 // available.
 260 static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
 261     std::size_t dateChars, char *time, std::size_t timeChars, char *zone,
 262     std::size_t zoneChars, const Fortran::runtime::Descriptor *values) {
 263
 264   timeval t;
 265   if (gettimeofday(&t, nullptr) != 0) {
 266     DateAndTimeUnavailable(
 267         terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
 268     return;
 269   }
 270   time_t timer{t.tv_sec};
 271   tm localTime;
 272   localtime_r(&timer, &localTime);
 273   std::intmax_t ms{t.tv_usec / 1000};
 274
 275   static constexpr std::size_t buffSize{16};
 276   char buffer[buffSize];
 277   auto copyBufferAndPad{
 278       [&](char *dest, std::size_t destChars, std::size_t len) {
 279         auto copyLen{std::min(len, destChars)};
 280         std::memcpy(dest, buffer, copyLen);
 281         for (auto i{copyLen}; i < destChars; ++i) {
 282           dest[i] = ' ';
 283         }
 284       }};
 285   if (date) {
 286     auto len = std::strftime(buffer, buffSize, "%Y%m%d", &localTime);
 287     copyBufferAndPad(date, dateChars, len);
 288   }
 289   if (time) {
 290     auto len{std::snprintf(buffer, buffSize, "%02d%02d%02d.%03jd",
 291         localTime.tm_hour, localTime.tm_min, localTime.tm_sec, ms)};
 292     copyBufferAndPad(time, timeChars, len);
 293   }
 294   if (zone) {
 295     // Note: this may leave the buffer empty on many platforms. Classic flang
 296     // has a much more complex way of doing this (see __io_timezone in classic
 297     // flang).
 298     auto len{std::strftime(buffer, buffSize, "%z", &localTime)};
 299     copyBufferAndPad(zone, zoneChars, len);
 300   }
 301   if (values) {
 302     auto typeCode{values->type().GetCategoryAndKind()};
 303     RUNTIME_CHECK(terminator,
 304         values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
 305             typeCode &&
 306             typeCode->first == Fortran::common::TypeCategory::Integer);
 307     // DATE_AND_TIME values argument must have decimal range > 4. Do not accept
 308     // KIND 1 here.
 309     int kind{typeCode->second};
 310     RUNTIME_CHECK(terminator, kind != 1);
 311     auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) {
 312       Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt,
 313           void>(kind, terminator, *values, atIndex, value);
 314     };
 315     storeIntegerAt(0, localTime.tm_year + 1900);
 316     storeIntegerAt(1, localTime.tm_mon + 1);
 317     storeIntegerAt(2, localTime.tm_mday);
 318     Fortran::runtime::ApplyIntegerKind<
 319         GmtOffsetHelper<struct tm>::StoreGmtOffset, void>(
 320         kind, terminator, *values, 3, localTime);
 321     storeIntegerAt(4, localTime.tm_hour);
 322     storeIntegerAt(5, localTime.tm_min);
 323     storeIntegerAt(6, localTime.tm_sec);
 324     storeIntegerAt(7, ms);
 325   }
 326 }
 327
 328 #else
 329 // Fallback implementation where gettimeofday or localtime_r are not both
 330 // available (e.g. windows).
 331 static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
 332     std::size_t dateChars, char *time, std::size_t timeChars, char *zone,
 333     std::size_t zoneChars, const Fortran::runtime::Descriptor *values) {
 334   // TODO: An actual implementation for non Posix system should be added.
 335   // So far, implement as if the date and time is not available on those
 336   // platforms.
 337   DateAndTimeUnavailable(
 338       terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
 339 }
 340 #endif
 341 } // namespace
 342
 343 namespace Fortran::runtime {
 344 extern "C" {
 345
 346 double RTNAME(CpuTime)() { return GetCpuTime(0); }
 347
 348 std::int64_t RTNAME(SystemClockCount)(int kind) {
 349   return GetSystemClockCount(kind, 0);
 350 }
 351
 352 std::int64_t RTNAME(SystemClockCountRate)(int kind) {
 353   return GetSystemClockCountRate(kind, 0);
 354 }
 355
 356 std::int64_t RTNAME(SystemClockCountMax)(int kind) {
 357   return GetSystemClockCountMax(kind, 0);
 358 }
 359
 360 void RTNAME(DateAndTime)(char *date, std::size_t dateChars, char *time,
 361     std::size_t timeChars, char *zone, std::size_t zoneChars,
 362     const char *source, int line, const Descriptor *values) {
 363   Fortran::runtime::Terminator terminator{source, line};
 364   return GetDateAndTime(
 365       terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
 366 }
 367
 368 } // extern "C"
 369 } // namespace Fortran::runtime