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.
42namespace {
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.
46using fallback_implementation = double;
47using preferred_implementation = int;
48
49// This is the fallback implementation, which should work everywhere.
50template <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.
79template <typename T = int, typename U = struct timespec>
80double 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, tp: &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
93using count_t = std::int64_t;
94using unsigned_count_t = std::uint64_t;
95
96// Computes HUGE(INT(0,kind)) as an unsigned integer value.
97static 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.
106template <typename Unused = void>
107count_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
126template <typename Unused = void>
127count_t GetSystemClockCountRate(int kind, fallback_implementation) {
128 return CLOCKS_PER_SEC;
129}
130
131template <typename Unused = void>
132count_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
144constexpr unsigned_count_t DS_PER_SEC{10u};
145constexpr unsigned_count_t MS_PER_SEC{1'000u};
146constexpr unsigned_count_t NS_PER_SEC{1'000'000'000u};
147
148#ifdef CLOCKID
149template <typename T = int, typename U = struct timespec>
150count_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, tp: &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
171template <typename T = int, typename U = struct timespec>
172count_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
179template <typename T = int, typename U = struct timespec>
180count_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
190template <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).
202static 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(s: date, c: static_cast<int>(' '), n: dateChars);
208 }
209 if (time) {
210 std::memset(s: time, c: static_cast<int>(' '), n: timeChars);
211 }
212 if (zone) {
213 std::memset(s: zone, c: static_cast<int>(' '), n: 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.
236template <int KIND, typename TM = struct tm>
237Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>
238GetGmtOffset(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}
243template <int KIND, typename TM = struct tm>
244Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>
245GetGmtOffset(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}
252template <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.
265static 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(tv: &t, tz: 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: &timer, tp: &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(a: len, b: destChars)};
285 std::memcpy(dest: dest, src: buffer, n: copyLen);
286 for (auto i{copyLen}; i < destChars; ++i) {
287 dest[i] = ' ';
288 }
289 }};
290 if (date) {
291 auto len = std::strftime(s: buffer, maxsize: buffSize, format: "%Y%m%d", tp: &localTime);
292 copyBufferAndPad(date, dateChars, len);
293 }
294 if (time) {
295 auto len{std::snprintf(s: buffer, maxlen: buffSize, format: "%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(s: buffer, maxsize: buffSize, format: "%z", tp: &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).
336static 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
348namespace Fortran::runtime {
349extern "C" {
350
351double RTNAME(CpuTime)() { return GetCpuTime(0); }
352
353std::int64_t RTNAME(SystemClockCount)(int kind) {
354 return GetSystemClockCount(kind, 0);
355}
356
357std::int64_t RTNAME(SystemClockCountRate)(int kind) {
358 return GetSystemClockCountRate(kind, 0);
359}
360
361std::int64_t RTNAME(SystemClockCountMax)(int kind) {
362 return GetSystemClockCountMax(kind, 0);
363}
364
365void 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
375

source code of flang/runtime/time-intrinsic.cpp