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