available, the implementation falls back to a potentially lower
resolution realtime clock.
-@var{COUNT_RATE} and @var{COUNT_MAX} vary depending on the kind of the
-arguments. For @var{kind=8} arguments, @var{COUNT} represents
-nanoseconds, and for @var{kind=4} arguments, @var{COUNT} represents
-milliseconds. Other than the kind dependency, @var{COUNT_RATE} and
-@var{COUNT_MAX} are constant, however the particular values are
-specific to @command{gfortran}.
+@var{COUNT_RATE} is system dependent and can vary depending on the kind of the
+arguments. For @var{kind=4} arguments, @var{COUNT} usually represents
+milliseconds, while for @var{kind=8} arguments, @var{COUNT} typically
+represents micro- or nanoseconds. @var{COUNT_MAX} usually equals
+@code{HUGE(COUNT_MAX)}.
If there is no clock, @var{COUNT} is set to @code{-HUGE(COUNT)}, and
@var{COUNT_RATE} and @var{COUNT_MAX} are set to zero.
+2012-12-03 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/55548
+ * intrinsics/system_clock.c (gf_gettime_mono): Add argument 'tck',
+ which returns the clock resolution.
+ (system_clock_4): Get resolution from gf_gettime_mono, but limit to
+ 1000/s.
+ (system_clock_8): Get resolution from gf_gettime_mono.
+
2012-10-28 Tobias Burnus <burnus@net-b.de>
* m4/bessel.m4: Remove useless statement.
Arguments:
secs - OUTPUT, seconds
nanosecs - OUTPUT, nanoseconds
+ tk - OUTPUT, clock resolution [counts/sec]
If the target supports a monotonic clock, the OUTPUT arguments
represent a monotonically incrementing clock starting from some
is set.
*/
static int
-gf_gettime_mono (time_t * secs, long * nanosecs)
+gf_gettime_mono (time_t * secs, long * nanosecs, long * tck)
{
int err;
#ifdef HAVE_CLOCK_GETTIME
struct timespec ts;
+ *tck = 1000000000;
err = clock_gettime (GF_CLOCK_MONOTONIC, &ts);
*secs = ts.tv_sec;
*nanosecs = ts.tv_nsec;
if (weak_gettime)
{
struct timespec ts;
+ *tck = 1000000000;
err = weak_gettime (GF_CLOCK_MONOTONIC, &ts);
*secs = ts.tv_sec;
*nanosecs = ts.tv_nsec;
return err;
}
#endif
+ *tck = 1000000;
err = gf_gettime (secs, nanosecs);
*nanosecs *= 1000;
return err;
system_clock_4(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
GFC_INTEGER_4 *count_max)
{
-#undef TCK
-#define TCK 1000
GFC_INTEGER_4 cnt;
GFC_INTEGER_4 mx;
time_t secs;
- long nanosecs;
+ long nanosecs, tck;
if (sizeof (secs) < sizeof (GFC_INTEGER_4))
internal_error (NULL, "secs too small");
- if (gf_gettime_mono (&secs, &nanosecs) == 0)
+ if (gf_gettime_mono (&secs, &nanosecs, &tck) == 0)
{
- GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) secs * TCK;
- ucnt += (nanosecs + 500000000 / TCK) / (1000000000 / TCK);
+ tck = tck>1000 ? 1000 : tck;
+ GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) secs * tck;
+ ucnt += (nanosecs + 500000000 / tck) / (1000000000 / tck);
if (ucnt > GFC_INTEGER_4_HUGE)
cnt = ucnt - GFC_INTEGER_4_HUGE - 1;
else
if (count != NULL)
*count = cnt;
if (count_rate != NULL)
- *count_rate = TCK;
+ *count_rate = tck;
if (count_max != NULL)
*count_max = mx;
}
system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
GFC_INTEGER_8 *count_max)
{
-#undef TCK
-#define TCK 1000000000
GFC_INTEGER_8 cnt;
GFC_INTEGER_8 mx;
time_t secs;
- long nanosecs;
+ long nanosecs, tck;
if (sizeof (secs) < sizeof (GFC_INTEGER_4))
internal_error (NULL, "secs too small");
- if (gf_gettime_mono (&secs, &nanosecs) == 0)
+ if (gf_gettime_mono (&secs, &nanosecs, &tck) == 0)
{
- GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) secs * TCK;
- ucnt += (nanosecs + 500000000 / TCK) / (1000000000 / TCK);
+ GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) secs * tck;
+ ucnt += (nanosecs + 500000000 / tck) / (1000000000 / tck);
if (ucnt > GFC_INTEGER_8_HUGE)
cnt = ucnt - GFC_INTEGER_8_HUGE - 1;
else
if (count != NULL)
*count = cnt;
if (count_rate != NULL)
- *count_rate = TCK;
+ *count_rate = tck;
if (count_max != NULL)
*count_max = mx;
}