libgfortran/intrinsics/system_clock.c

   1 /* Implementation of the SYSTEM_CLOCK intrinsic.
   2    Copyright (C) 2004-2013 Free Software Foundation, Inc.
   3
   4 This file is part of the GNU Fortran runtime library (libgfortran).
   5
   6 Libgfortran is free software; you can redistribute it and/or
   7 modify it under the terms of the GNU General Public
   8 License as published by the Free Software Foundation; either
   9 version 3 of the License, or (at your option) any later version.
  10
  11 Libgfortran is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 Under Section 7 of GPL version 3, you are granted additional
  17 permissions described in the GCC Runtime Library Exception, version
  18 3.1, as published by the Free Software Foundation.
  19
  20 You should have received a copy of the GNU General Public License and
  21 a copy of the GCC Runtime Library Exception along with this program;
  22 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  23 <http://www.gnu.org/licenses/>.  */
  24
  25 #include "libgfortran.h"
  26
  27 #include <limits.h>
  28
  29 #include "time_1.h"
  30
  31
  32 #if !defined(__MINGW32__) && !defined(__CYGWIN__)
  33
  34 /* POSIX states that CLOCK_REALTIME must be present if clock_gettime
  35    is available, others are optional.  */
  36 #if defined(HAVE_CLOCK_GETTIME) || defined(HAVE_CLOCK_GETTIME_LIBRT)
  37 #if defined(CLOCK_MONOTONIC) && defined(_POSIX_MONOTONIC_CLOCK) \
  38   && _POSIX_MONOTONIC_CLOCK >= 0
  39 #define GF_CLOCK_MONOTONIC CLOCK_MONOTONIC
  40 #else
  41 #define GF_CLOCK_MONOTONIC CLOCK_REALTIME
  42 #endif
  43 #endif
  44
  45 /* Weakref trickery for clock_gettime().  On Glibc <= 2.16,
  46    clock_gettime() requires us to link in librt, which also pulls in
  47    libpthread.  In order to avoid this by default, only call
  48    clock_gettime() through a weak reference.
  49
  50    Some targets don't support weak undefined references; on these
  51    GTHREAD_USE_WEAK is 0. So we need to define it to 1 on other
  52    targets.  */
  53 #ifndef GTHREAD_USE_WEAK
  54 #define GTHREAD_USE_WEAK 1
  55 #endif
  56
  57 #if SUPPORTS_WEAK && GTHREAD_USE_WEAK && defined(HAVE_CLOCK_GETTIME_LIBRT)
  58 static int weak_gettime (clockid_t, struct timespec *)
  59   __attribute__((__weakref__("clock_gettime")));
  60 #endif
  61
  62
  63 /* High resolution monotonic clock, falling back to the realtime clock
  64    if the target does not support such a clock.
  65
  66    Arguments:
  67    secs     - OUTPUT, seconds
  68    nanosecs - OUTPUT, nanoseconds
  69    tk       - OUTPUT, clock resolution [counts/sec]
  70
  71    If the target supports a monotonic clock, the OUTPUT arguments
  72    represent a monotonically incrementing clock starting from some
  73    unspecified time in the past.
  74
  75    If a monotonic clock is not available, falls back to the realtime
  76    clock which is not monotonic.
  77
  78    Return value: 0 for success, -1 for error. In case of error, errno
  79    is set.
  80 */
  81 static int
  82 gf_gettime_mono (time_t * secs, long * nanosecs, long * tck)
  83 {
  84   int err;
  85 #ifdef HAVE_CLOCK_GETTIME
  86   struct timespec ts;
  87   *tck = 1000000000;
  88   err = clock_gettime (GF_CLOCK_MONOTONIC, &ts);
  89   *secs = ts.tv_sec;
  90   *nanosecs = ts.tv_nsec;
  91   return err;
  92 #else
  93 #if defined(HAVE_CLOCK_GETTIME_LIBRT) && SUPPORTS_WEAK && GTHREAD_USE_WEAK
  94   if (weak_gettime)
  95     {
  96       struct timespec ts;
  97       *tck = 1000000000;
  98       err = weak_gettime (GF_CLOCK_MONOTONIC, &ts);
  99       *secs = ts.tv_sec;
 100       *nanosecs = ts.tv_nsec;
 101       return err;
 102     }
 103 #endif
 104   *tck = 1000000;
 105   err = gf_gettime (secs, nanosecs);
 106   *nanosecs *= 1000;
 107   return err;
 108 #endif
 109 }
 110
 111 #endif /* !__MINGW32 && !__CYGWIN__  */
 112
 113 extern void system_clock_4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *);
 114 export_proto(system_clock_4);
 115
 116 extern void system_clock_8 (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *);
 117 export_proto(system_clock_8);
 118
 119
 120 /* prefix(system_clock_4) is the INTEGER(4) version of the SYSTEM_CLOCK
 121    intrinsic subroutine.  It returns the number of clock ticks for the current
 122    system time, the number of ticks per second, and the maximum possible value
 123    for COUNT.  */
 124
 125 void
 126 system_clock_4(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
 127                GFC_INTEGER_4 *count_max)
 128 {
 129 #if defined(__MINGW32__) || defined(__CYGWIN__)
 130   if (count)
 131     {
 132       /* Use GetTickCount here as the resolution and range is
 133          sufficient for the INTEGER(kind=4) version, and
 134          QueryPerformanceCounter has potential issues.  */
 135       uint32_t cnt = GetTickCount ();
 136       if (cnt > GFC_INTEGER_4_HUGE)
 137         cnt = cnt - GFC_INTEGER_4_HUGE - 1;
 138       *count = cnt;
 139     }
 140   if (count_rate)
 141     *count_rate = 1000;
 142   if (count_max)
 143     *count_max = GFC_INTEGER_4_HUGE;
 144 #else
 145   GFC_INTEGER_4 cnt;
 146   GFC_INTEGER_4 mx;
 147
 148   time_t secs;
 149   long nanosecs, tck;
 150
 151   if (sizeof (secs) < sizeof (GFC_INTEGER_4))
 152     internal_error (NULL, "secs too small");
 153
 154   if (gf_gettime_mono (&secs, &nanosecs, &tck) == 0)
 155     {
 156       tck = tck>1000 ? 1000 : tck;
 157       GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) secs * tck;
 158       ucnt += (nanosecs + 500000000 / tck) / (1000000000 / tck);
 159       if (ucnt > GFC_INTEGER_4_HUGE)
 160         cnt = ucnt - GFC_INTEGER_4_HUGE - 1;
 161       else
 162         cnt = ucnt;
 163       mx = GFC_INTEGER_4_HUGE;
 164     }
 165   else
 166     {
 167       if (count != NULL)
 168         *count = - GFC_INTEGER_4_HUGE;
 169       if (count_rate != NULL)
 170         *count_rate = 0;
 171       if (count_max != NULL)
 172         *count_max = 0;
 173       return;
 174     }
 175
 176   if (count != NULL)
 177     *count = cnt;
 178   if (count_rate != NULL)
 179     *count_rate = tck;
 180   if (count_max != NULL)
 181     *count_max = mx;
 182 #endif
 183 }
 184
 185
 186 /* INTEGER(8) version of the above routine.  */
 187
 188 void
 189 system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
 190                 GFC_INTEGER_8 *count_max)
 191 {
 192 #if defined(__MINGW32__) || defined(__CYGWIN__)
 193   LARGE_INTEGER cnt;
 194   LARGE_INTEGER freq;
 195   bool fail = false;
 196   if (count && !QueryPerformanceCounter (&cnt))
 197     fail = true;
 198   if (count_rate && !QueryPerformanceFrequency (&freq))
 199     fail = true;
 200   if (fail)
 201     {
 202       if (count)
 203         *count = - GFC_INTEGER_8_HUGE;
 204       if (count_rate)
 205         *count_rate = 0;
 206       if (count_max)
 207         *count_max = 0;
 208     }
 209   else
 210     {
 211       if (count)
 212         *count = cnt.QuadPart;
 213       if (count_rate)
 214         *count_rate = freq.QuadPart;
 215       if (count_max)
 216         *count_max = GFC_INTEGER_8_HUGE;
 217     }
 218 #else
 219   GFC_INTEGER_8 cnt;
 220   GFC_INTEGER_8 mx;
 221
 222   time_t secs;
 223   long nanosecs, tck;
 224
 225   if (sizeof (secs) < sizeof (GFC_INTEGER_4))
 226     internal_error (NULL, "secs too small");
 227
 228   if (gf_gettime_mono (&secs, &nanosecs, &tck) == 0)
 229     {
 230       GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) secs * tck;
 231       ucnt += (nanosecs + 500000000 / tck) / (1000000000 / tck);
 232       if (ucnt > GFC_INTEGER_8_HUGE)
 233         cnt = ucnt - GFC_INTEGER_8_HUGE - 1;
 234       else
 235         cnt = ucnt;
 236       mx = GFC_INTEGER_8_HUGE;
 237     }
 238   else
 239     {
 240       if (count != NULL)
 241         *count = - GFC_INTEGER_8_HUGE;
 242       if (count_rate != NULL)
 243         *count_rate = 0;
 244       if (count_max != NULL)
 245         *count_max = 0;
 246
 247       return;
 248     }
 249
 250   if (count != NULL)
 251     *count = cnt;
 252   if (count_rate != NULL)
 253     *count_rate = tck;
 254   if (count_max != NULL)
 255     *count_max = mx;
 256 #endif
 257 }