llvm-project
453 строки · 16.5 Кб
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#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.
46namespace {
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.
50using fallback_implementation = double;
51using preferred_implementation = int;
52
53// This is the fallback implementation, which should work everywhere.
54template <typename Unused = void> double GetCpuTime(fallback_implementation) {
55std::clock_t timestamp{std::clock()};
56if (timestamp != static_cast<std::clock_t>(-1)) {
57return static_cast<double>(timestamp) / CLOCKS_PER_SEC;
58}
59// Return some negative value to represent failure.
60return -1.0;
61}
62
63#if defined __MINGW32__
64// clock_gettime is implemented in the pthread library for MinGW.
65// Using it here would mean that all programs that link libFortranRuntime are
66// required to also link to pthread. Instead, don't use the function.
67#undef CLOCKID_CPU_TIME
68#undef CLOCKID_ELAPSED_TIME
69#else
70// Determine what clock to use for CPU time.
71#if defined CLOCK_PROCESS_CPUTIME_ID
72#define CLOCKID_CPU_TIME CLOCK_PROCESS_CPUTIME_ID
73#elif defined CLOCK_THREAD_CPUTIME_ID
74#define CLOCKID_CPU_TIME CLOCK_THREAD_CPUTIME_ID
75#else
76#undef CLOCKID_CPU_TIME
77#endif
78
79// Determine what clock to use for elapsed time.
80#if defined CLOCK_MONOTONIC
81#define CLOCKID_ELAPSED_TIME CLOCK_MONOTONIC
82#elif defined CLOCK_REALTIME
83#define CLOCKID_ELAPSED_TIME CLOCK_REALTIME
84#else
85#undef CLOCKID_ELAPSED_TIME
86#endif
87#endif
88
89#ifdef CLOCKID_CPU_TIME
90// POSIX implementation using clock_gettime. This is only enabled where
91// clock_gettime is available.
92template <typename T = int, typename U = struct timespec>
93double GetCpuTime(preferred_implementation,
94// We need some dummy parameters to pass to decltype(clock_gettime).
95T ClockId = 0, U *Timespec = nullptr,
96decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
97struct timespec tspec;
98if (clock_gettime(CLOCKID_CPU_TIME, &tspec) == 0) {
99return tspec.tv_nsec * 1.0e-9 + tspec.tv_sec;
100}
101// Return some negative value to represent failure.
102return -1.0;
103}
104#endif // CLOCKID_CPU_TIME
105
106using count_t = std::int64_t;
107using unsigned_count_t = std::uint64_t;
108
109// POSIX implementation using clock_gettime where available. The clock_gettime
110// result is in nanoseconds, which is converted as necessary to
111// - deciseconds for kind 1
112// - milliseconds for kinds 2, 4
113// - nanoseconds for kinds 8, 16
114constexpr unsigned_count_t DS_PER_SEC{10u};
115constexpr unsigned_count_t MS_PER_SEC{1'000u};
116constexpr unsigned_count_t NS_PER_SEC{1'000'000'000u};
117
118// Computes HUGE(INT(0,kind)) as an unsigned integer value.
119static constexpr inline unsigned_count_t GetHUGE(int kind) {
120if (kind > 8) {
121kind = 8;
122}
123return (unsigned_count_t{1} << ((8 * kind) - 1)) - 1;
124}
125
126// Function converts a std::timespec_t into the desired count to
127// be returned by the timing functions in accordance with the requested
128// kind at the call site.
129count_t ConvertTimeSpecToCount(int kind, const struct timespec &tspec) {
130const unsigned_count_t huge{GetHUGE(kind)};
131unsigned_count_t sec{static_cast<unsigned_count_t>(tspec.tv_sec)};
132unsigned_count_t nsec{static_cast<unsigned_count_t>(tspec.tv_nsec)};
133if (kind >= 8) {
134return (sec * NS_PER_SEC + nsec) % (huge + 1);
135} else if (kind >= 2) {
136return (sec * MS_PER_SEC + (nsec / (NS_PER_SEC / MS_PER_SEC))) % (huge + 1);
137} else { // kind == 1
138return (sec * DS_PER_SEC + (nsec / (NS_PER_SEC / DS_PER_SEC))) % (huge + 1);
139}
140}
141
142// This is the fallback implementation, which should work everywhere.
143template <typename Unused = void>
144count_t GetSystemClockCount(int kind, fallback_implementation) {
145struct timespec tspec;
146
147if (timespec_get(&tspec, TIME_UTC) < 0) {
148// Return -HUGE(COUNT) to represent failure.
149return -static_cast<count_t>(GetHUGE(kind));
150}
151
152// Compute the timestamp as seconds plus nanoseconds in accordance
153// with the requested kind at the call site.
154return ConvertTimeSpecToCount(kind, tspec);
155}
156
157template <typename Unused = void>
158count_t GetSystemClockCountRate(int kind, fallback_implementation) {
159return kind >= 8 ? NS_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC;
160}
161
162template <typename Unused = void>
163count_t GetSystemClockCountMax(int kind, fallback_implementation) {
164unsigned_count_t maxCount{GetHUGE(kind)};
165return maxCount;
166}
167
168#ifdef CLOCKID_ELAPSED_TIME
169template <typename T = int, typename U = struct timespec>
170count_t GetSystemClockCount(int kind, preferred_implementation,
171// We need some dummy parameters to pass to decltype(clock_gettime).
172T ClockId = 0, U *Timespec = nullptr,
173decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
174struct timespec tspec;
175const unsigned_count_t huge{GetHUGE(kind)};
176if (clock_gettime(CLOCKID_ELAPSED_TIME, &tspec) != 0) {
177return -huge; // failure
178}
179
180// Compute the timestamp as seconds plus nanoseconds in accordance
181// with the requested kind at the call site.
182return ConvertTimeSpecToCount(kind, tspec);
183}
184#endif // CLOCKID_ELAPSED_TIME
185
186template <typename T = int, typename U = struct timespec>
187count_t GetSystemClockCountRate(int kind, preferred_implementation,
188// We need some dummy parameters to pass to decltype(clock_gettime).
189T ClockId = 0, U *Timespec = nullptr,
190decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
191return kind >= 8 ? NS_PER_SEC : kind >= 2 ? MS_PER_SEC : DS_PER_SEC;
192}
193
194template <typename T = int, typename U = struct timespec>
195count_t GetSystemClockCountMax(int kind, preferred_implementation,
196// We need some dummy parameters to pass to decltype(clock_gettime).
197T ClockId = 0, U *Timespec = nullptr,
198decltype(clock_gettime(ClockId, Timespec)) *Enabled = nullptr) {
199return GetHUGE(kind);
200}
201
202// DATE_AND_TIME (Fortran 2018 16.9.59)
203
204// Helper to set an integer value to -HUGE
205template <int KIND> struct StoreNegativeHugeAt {
206void operator()(
207const Fortran::runtime::Descriptor &result, std::size_t at) const {
208*result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
209Fortran::common::TypeCategory::Integer, KIND>>(at) =
210-std::numeric_limits<Fortran::runtime::CppTypeFor<
211Fortran::common::TypeCategory::Integer, KIND>>::max();
212}
213};
214
215// Default implementation when date and time information is not available (set
216// strings to blanks and values to -HUGE as defined by the standard).
217static void DateAndTimeUnavailable(Fortran::runtime::Terminator &terminator,
218char *date, std::size_t dateChars, char *time, std::size_t timeChars,
219char *zone, std::size_t zoneChars,
220const Fortran::runtime::Descriptor *values) {
221if (date) {
222std::memset(date, static_cast<int>(' '), dateChars);
223}
224if (time) {
225std::memset(time, static_cast<int>(' '), timeChars);
226}
227if (zone) {
228std::memset(zone, static_cast<int>(' '), zoneChars);
229}
230if (values) {
231auto typeCode{values->type().GetCategoryAndKind()};
232RUNTIME_CHECK(terminator,
233values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
234typeCode &&
235typeCode->first == Fortran::common::TypeCategory::Integer);
236// DATE_AND_TIME values argument must have decimal range > 4. Do not accept
237// KIND 1 here.
238int kind{typeCode->second};
239RUNTIME_CHECK(terminator, kind != 1);
240for (std::size_t i = 0; i < 8; ++i) {
241Fortran::runtime::ApplyIntegerKind<StoreNegativeHugeAt, void>(
242kind, terminator, *values, i);
243}
244}
245}
246
247#ifndef _WIN32
248
249// SFINAE helper to return the struct tm.tm_gmtoff which is not a POSIX standard
250// field.
251template <int KIND, typename TM = struct tm>
252Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>
253GetGmtOffset(const TM &tm, preferred_implementation,
254decltype(tm.tm_gmtoff) *Enabled = nullptr) {
255// Returns the GMT offset in minutes.
256return tm.tm_gmtoff / 60;
257}
258template <int KIND, typename TM = struct tm>
259Fortran::runtime::CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>
260GetGmtOffset(const TM &tm, fallback_implementation) {
261// tm.tm_gmtoff is not available, there may be platform dependent alternatives
262// (such as using timezone from <time.h> when available), but so far just
263// return -HUGE to report that this information is not available.
264return -std::numeric_limits<Fortran::runtime::CppTypeFor<
265Fortran::common::TypeCategory::Integer, KIND>>::max();
266}
267template <typename TM = struct tm> struct GmtOffsetHelper {
268template <int KIND> struct StoreGmtOffset {
269void operator()(const Fortran::runtime::Descriptor &result, std::size_t at,
270TM &tm) const {
271*result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
272Fortran::common::TypeCategory::Integer, KIND>>(at) =
273GetGmtOffset<KIND>(tm, 0);
274}
275};
276};
277
278// Dispatch to posix implementation where gettimeofday and localtime_r are
279// available.
280static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
281std::size_t dateChars, char *time, std::size_t timeChars, char *zone,
282std::size_t zoneChars, const Fortran::runtime::Descriptor *values) {
283
284timeval t;
285if (gettimeofday(&t, nullptr) != 0) {
286DateAndTimeUnavailable(
287terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
288return;
289}
290time_t timer{t.tv_sec};
291tm localTime;
292localtime_r(&timer, &localTime);
293std::intmax_t ms{t.tv_usec / 1000};
294
295static constexpr std::size_t buffSize{16};
296char buffer[buffSize];
297auto copyBufferAndPad{
298[&](char *dest, std::size_t destChars, std::size_t len) {
299auto copyLen{std::min(len, destChars)};
300std::memcpy(dest, buffer, copyLen);
301for (auto i{copyLen}; i < destChars; ++i) {
302dest[i] = ' ';
303}
304}};
305if (date) {
306auto len = std::strftime(buffer, buffSize, "%Y%m%d", &localTime);
307copyBufferAndPad(date, dateChars, len);
308}
309if (time) {
310auto len{std::snprintf(buffer, buffSize, "%02d%02d%02d.%03jd",
311localTime.tm_hour, localTime.tm_min, localTime.tm_sec, ms)};
312copyBufferAndPad(time, timeChars, len);
313}
314if (zone) {
315// Note: this may leave the buffer empty on many platforms. Classic flang
316// has a much more complex way of doing this (see __io_timezone in classic
317// flang).
318auto len{std::strftime(buffer, buffSize, "%z", &localTime)};
319copyBufferAndPad(zone, zoneChars, len);
320}
321if (values) {
322auto typeCode{values->type().GetCategoryAndKind()};
323RUNTIME_CHECK(terminator,
324values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
325typeCode &&
326typeCode->first == Fortran::common::TypeCategory::Integer);
327// DATE_AND_TIME values argument must have decimal range > 4. Do not accept
328// KIND 1 here.
329int kind{typeCode->second};
330RUNTIME_CHECK(terminator, kind != 1);
331auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) {
332Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt,
333void>(kind, terminator, *values, atIndex, value);
334};
335storeIntegerAt(0, localTime.tm_year + 1900);
336storeIntegerAt(1, localTime.tm_mon + 1);
337storeIntegerAt(2, localTime.tm_mday);
338Fortran::runtime::ApplyIntegerKind<
339GmtOffsetHelper<struct tm>::StoreGmtOffset, void>(
340kind, terminator, *values, 3, localTime);
341storeIntegerAt(4, localTime.tm_hour);
342storeIntegerAt(5, localTime.tm_min);
343storeIntegerAt(6, localTime.tm_sec);
344storeIntegerAt(7, ms);
345}
346}
347
348#else
349// Fallback implementation where gettimeofday or localtime_r are not both
350// available (e.g. windows).
351static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
352std::size_t dateChars, char *time, std::size_t timeChars, char *zone,
353std::size_t zoneChars, const Fortran::runtime::Descriptor *values) {
354// TODO: An actual implementation for non Posix system should be added.
355// So far, implement as if the date and time is not available on those
356// platforms.
357DateAndTimeUnavailable(
358terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
359}
360#endif
361} // namespace
362
363namespace Fortran::runtime {
364extern "C" {
365
366double RTNAME(CpuTime)() { return GetCpuTime(0); }
367
368std::int64_t RTNAME(SystemClockCount)(int kind) {
369return GetSystemClockCount(kind, 0);
370}
371
372std::int64_t RTNAME(SystemClockCountRate)(int kind) {
373return GetSystemClockCountRate(kind, 0);
374}
375
376std::int64_t RTNAME(SystemClockCountMax)(int kind) {
377return GetSystemClockCountMax(kind, 0);
378}
379
380void RTNAME(DateAndTime)(char *date, std::size_t dateChars, char *time,
381std::size_t timeChars, char *zone, std::size_t zoneChars,
382const char *source, int line, const Descriptor *values) {
383Fortran::runtime::Terminator terminator{source, line};
384return GetDateAndTime(
385terminator, date, dateChars, time, timeChars, zone, zoneChars, values);
386}
387
388void RTNAME(Etime)(const Descriptor *values, const Descriptor *time,
389const char *sourceFile, int line) {
390Fortran::runtime::Terminator terminator{sourceFile, line};
391
392double usrTime = -1.0, sysTime = -1.0, realTime = -1.0;
393
394#ifdef _WIN32
395FILETIME creationTime;
396FILETIME exitTime;
397FILETIME kernelTime;
398FILETIME userTime;
399
400if (GetProcessTimes(GetCurrentProcess(), &creationTime, &exitTime,
401&kernelTime, &userTime) == 0) {
402ULARGE_INTEGER userSystemTime;
403ULARGE_INTEGER kernelSystemTime;
404
405memcpy(&userSystemTime, &userTime, sizeof(FILETIME));
406memcpy(&kernelSystemTime, &kernelTime, sizeof(FILETIME));
407
408usrTime = ((double)(userSystemTime.QuadPart)) / 10000000.0;
409sysTime = ((double)(kernelSystemTime.QuadPart)) / 10000000.0;
410realTime = usrTime + sysTime;
411}
412#else
413struct tms tms;
414if (times(&tms) != (clock_t)-1) {
415usrTime = ((double)(tms.tms_utime)) / sysconf(_SC_CLK_TCK);
416sysTime = ((double)(tms.tms_stime)) / sysconf(_SC_CLK_TCK);
417realTime = usrTime + sysTime;
418}
419#endif
420
421if (values) {
422auto typeCode{values->type().GetCategoryAndKind()};
423// ETIME values argument must have decimal range == 2.
424RUNTIME_CHECK(terminator,
425values->rank() == 1 && values->GetDimension(0).Extent() == 2 &&
426typeCode && typeCode->first == Fortran::common::TypeCategory::Real);
427// Only accept KIND=4 here.
428int kind{typeCode->second};
429RUNTIME_CHECK(terminator, kind == 4);
430
431ApplyFloatingPointKind<StoreFloatingPointAt, void>(
432kind, terminator, *values, /* atIndex = */ 0, usrTime);
433ApplyFloatingPointKind<StoreFloatingPointAt, void>(
434kind, terminator, *values, /* atIndex = */ 1, sysTime);
435}
436
437if (time) {
438auto typeCode{time->type().GetCategoryAndKind()};
439// ETIME time argument must have decimal range == 0.
440RUNTIME_CHECK(terminator,
441time->rank() == 0 && typeCode &&
442typeCode->first == Fortran::common::TypeCategory::Real);
443// Only accept KIND=4 here.
444int kind{typeCode->second};
445RUNTIME_CHECK(terminator, kind == 4);
446
447ApplyFloatingPointKind<StoreFloatingPointAt, void>(
448kind, terminator, *time, /* atIndex = */ 0, realTime);
449}
450}
451
452} // extern "C"
453} // namespace Fortran::runtime
454