diff options
Diffstat (limited to 'libgfortran/intrinsics/system_clock.c')
| -rw-r--r-- | libgfortran/intrinsics/system_clock.c | 230 |
1 files changed, 230 insertions, 0 deletions
diff --git a/libgfortran/intrinsics/system_clock.c b/libgfortran/intrinsics/system_clock.c new file mode 100644 index 0000000000..5674d493af --- /dev/null +++ b/libgfortran/intrinsics/system_clock.c @@ -0,0 +1,230 @@ +/* Implementation of the SYSTEM_CLOCK intrinsic. + Copyright (C) 2004-2017 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#include "libgfortran.h" + +#include <limits.h> + +#include "time_1.h" + + +#if !defined(__MINGW32__) + +/* POSIX states that CLOCK_REALTIME must be present if clock_gettime + is available, others are optional. */ +#if defined(HAVE_CLOCK_GETTIME) || defined(HAVE_CLOCK_GETTIME_LIBRT) +#if defined(CLOCK_MONOTONIC) && defined(_POSIX_MONOTONIC_CLOCK) \ + && _POSIX_MONOTONIC_CLOCK >= 0 +#define GF_CLOCK_MONOTONIC CLOCK_MONOTONIC +#else +#define GF_CLOCK_MONOTONIC CLOCK_REALTIME +#endif +#endif + +/* Weakref trickery for clock_gettime(). On Glibc <= 2.16, + clock_gettime() requires us to link in librt, which also pulls in + libpthread. In order to avoid this by default, only call + clock_gettime() through a weak reference. */ +#if SUPPORTS_WEAKREF && defined(HAVE_CLOCK_GETTIME_LIBRT) +static int weak_gettime (clockid_t, struct timespec *) + __attribute__((__weakref__("clock_gettime"))); +#endif + + +/* High resolution monotonic clock, falling back to the realtime clock + if the target does not support such a clock. + + Arguments: + secs - OUTPUT, seconds + fracsecs - OUTPUT, fractional seconds, units given by tk argument + tk - OUTPUT, clock resolution [counts/sec] + + If the target supports a monotonic clock, the OUTPUT arguments + represent a monotonically incrementing clock starting from some + unspecified time in the past. + + If a monotonic clock is not available, falls back to the realtime + clock which is not monotonic. + + Return value: 0 for success, -1 for error. In case of error, errno + is set. +*/ +static int +gf_gettime_mono (time_t * secs, long * fracsecs, long * tck) +{ + int err; +#ifdef HAVE_CLOCK_GETTIME + struct timespec ts; + *tck = 1000000000; + err = clock_gettime (GF_CLOCK_MONOTONIC, &ts); + *secs = ts.tv_sec; + *fracsecs = ts.tv_nsec; + return err; +#else +#if SUPPORTS_WEAKREF && defined(HAVE_CLOCK_GETTIME_LIBRT) + if (weak_gettime) + { + struct timespec ts; + *tck = 1000000000; + err = weak_gettime (GF_CLOCK_MONOTONIC, &ts); + *secs = ts.tv_sec; + *fracsecs = ts.tv_nsec; + return err; + } +#endif + *tck = 1000000; + err = gf_gettime (secs, fracsecs); + return err; +#endif +} + +#endif /* !__MINGW32__ */ + +extern void +system_clock_4 (GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate, + GFC_INTEGER_4 *count_max); +export_proto(system_clock_4); + +extern void +system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, + GFC_INTEGER_8 *count_max); +export_proto(system_clock_8); + + +/* prefix(system_clock_4) is the INTEGER(4) version of the SYSTEM_CLOCK + intrinsic subroutine. It returns the number of clock ticks for the current + system time, the number of ticks per second, and the maximum possible value + for COUNT. */ + +void +system_clock_4 (GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate, + GFC_INTEGER_4 *count_max) +{ +#if defined(__MINGW32__) + if (count) + { + /* Use GetTickCount here as the resolution and range is + sufficient for the INTEGER(kind=4) version, and + QueryPerformanceCounter has potential issues. */ + uint32_t cnt = GetTickCount (); + if (cnt > GFC_INTEGER_4_HUGE) + cnt = cnt - GFC_INTEGER_4_HUGE - 1; + *count = cnt; + } + if (count_rate) + *count_rate = 1000; + if (count_max) + *count_max = GFC_INTEGER_4_HUGE; +#else + time_t secs; + long fracsecs, tck; + + if (gf_gettime_mono (&secs, &fracsecs, &tck) == 0) + { + long tck_out = tck > 1000 ? 1000 : tck; + long tck_r = tck / tck_out; + GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) secs * tck_out; + ucnt += fracsecs / tck_r; + if (ucnt > GFC_INTEGER_4_HUGE) + ucnt = ucnt - GFC_INTEGER_4_HUGE - 1; + if (count) + *count = ucnt; + if (count_rate) + *count_rate = tck_out; + if (count_max) + *count_max = GFC_INTEGER_4_HUGE; + } + else + { + if (count) + *count = - GFC_INTEGER_4_HUGE; + if (count_rate) + *count_rate = 0; + if (count_max) + *count_max = 0; + } +#endif +} + + +/* INTEGER(8) version of the above routine. */ + +void +system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, + GFC_INTEGER_8 *count_max) +{ +#if defined(__MINGW32__) + LARGE_INTEGER cnt; + LARGE_INTEGER freq; + bool fail = false; + if (count && !QueryPerformanceCounter (&cnt)) + fail = true; + if (count_rate && !QueryPerformanceFrequency (&freq)) + fail = true; + if (fail) + { + if (count) + *count = - GFC_INTEGER_8_HUGE; + if (count_rate) + *count_rate = 0; + if (count_max) + *count_max = 0; + } + else + { + if (count) + *count = cnt.QuadPart; + if (count_rate) + *count_rate = freq.QuadPart; + if (count_max) + *count_max = GFC_INTEGER_8_HUGE; + } +#else + time_t secs; + long fracsecs, tck; + + if (gf_gettime_mono (&secs, &fracsecs, &tck) == 0) + { + GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) secs * tck; + ucnt += fracsecs; + if (ucnt > GFC_INTEGER_8_HUGE) + ucnt = ucnt - GFC_INTEGER_8_HUGE - 1; + if (count) + *count = ucnt; + if (count_rate) + *count_rate = tck; + if (count_max) + *count_max = GFC_INTEGER_8_HUGE; + } + else + { + if (count) + *count = - GFC_INTEGER_8_HUGE; + if (count_rate) + *count_rate = 0; + if (count_max) + *count_max = 0; + } +#endif +} |