Home | History | Annotate | Line # | Download | only in intrinsics 
      1 /* Implementation of the SYSTEM_CLOCK intrinsic.
      2    Copyright (C) 2004-2022 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__)
     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 #if SUPPORTS_WEAKREF && defined(HAVE_CLOCK_GETTIME_LIBRT)
     50 static int weak_gettime (clockid_t, struct timespec *)
     51   __attribute__((__weakref__("clock_gettime")));
     52 #endif
     53 
     54 
     55 /* High resolution monotonic clock, falling back to the realtime clock
     56    if the target does not support such a clock.
     57 
     58    Arguments:
     59    secs     - OUTPUT, seconds
     60    fracsecs - OUTPUT, fractional seconds, units given by tk argument
     61    tk       - OUTPUT, clock resolution [counts/sec]
     62 
     63    If the target supports a monotonic clock, the OUTPUT arguments
     64    represent a monotonically incrementing clock starting from some
     65    unspecified time in the past.
     66 
     67    If a monotonic clock is not available, falls back to the realtime
     68    clock which is not monotonic.
     69 
     70    Return value: 0 for success, -1 for error. In case of error, errno
     71    is set.
     72 */
     73 static int
     74 gf_gettime_mono (time_t * secs, long * fracsecs, long * tck)
     75 {
     76   int err;
     77 #ifdef HAVE_CLOCK_GETTIME
     78   struct timespec ts;
     79   *tck = 1000000000;
     80   err = clock_gettime (GF_CLOCK_MONOTONIC, &ts);
     81   *secs = ts.tv_sec;
     82   *fracsecs = ts.tv_nsec;
     83   return err;
     84 #else
     85 #if SUPPORTS_WEAKREF && defined(HAVE_CLOCK_GETTIME_LIBRT)
     86   if (weak_gettime)
     87     {
     88       struct timespec ts;
     89       *tck = 1000000000;
     90       err = weak_gettime (GF_CLOCK_MONOTONIC, &ts);
     91       *secs = ts.tv_sec;
     92       *fracsecs = ts.tv_nsec;
     93       return err;
     94     }
     95 #endif
     96   *tck = 1000000;
     97   err = gf_gettime (secs, fracsecs);
     98   return err;
     99 #endif
    100 }
    101 
    102 #endif /* !__MINGW32__  */
    103 
    104 extern void
    105 system_clock_4 (GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
    106 		GFC_INTEGER_4 *count_max);
    107 export_proto(system_clock_4);
    108 
    109 extern void
    110 system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
    111 		GFC_INTEGER_8 *count_max);
    112 export_proto(system_clock_8);
    113 
    114 
    115 /* prefix(system_clock_4) is the INTEGER(4) version of the SYSTEM_CLOCK
    116    intrinsic subroutine.  It returns the number of clock ticks for the current
    117    system time, the number of ticks per second, and the maximum possible value
    118    for COUNT.  */
    119 
    120 void
    121 system_clock_4 (GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
    122 	       GFC_INTEGER_4 *count_max)
    123 {
    124 #if defined(__MINGW32__)
    125   if (count)
    126     {
    127       /* Use GetTickCount here as the resolution and range is
    128 	 sufficient for the INTEGER(kind=4) version, and
    129 	 QueryPerformanceCounter has potential issues.  */
    130       uint32_t cnt = GetTickCount ();
    131       if (cnt > GFC_INTEGER_4_HUGE)
    132 	cnt = cnt - GFC_INTEGER_4_HUGE - 1;
    133       *count = cnt;
    134     }
    135   if (count_rate)
    136     *count_rate = 1000;
    137   if (count_max)
    138     *count_max = GFC_INTEGER_4_HUGE;
    139 #else
    140   time_t secs;
    141   long fracsecs, tck;
    142 
    143   if (gf_gettime_mono (&secs, &fracsecs, &tck) == 0)
    144     {
    145       long tck_out = tck > 1000 ? 1000 : tck;
    146       long tck_r = tck / tck_out;
    147       GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) secs * tck_out;
    148       ucnt += fracsecs / tck_r;
    149       if (ucnt > GFC_INTEGER_4_HUGE)
    150 	ucnt = ucnt - GFC_INTEGER_4_HUGE - 1;
    151       if (count)
    152 	*count = ucnt;
    153       if (count_rate)
    154 	*count_rate = tck_out;
    155       if (count_max)
    156 	*count_max = GFC_INTEGER_4_HUGE;
    157     }
    158   else
    159     {
    160       if (count)
    161 	*count = - GFC_INTEGER_4_HUGE;
    162       if (count_rate)
    163 	*count_rate = 0;
    164       if (count_max)
    165 	*count_max = 0;
    166     }
    167 #endif
    168 }
    169 
    170 
    171 /* INTEGER(8) version of the above routine.  */
    172 
    173 void
    174 system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
    175 		 GFC_INTEGER_8 *count_max)
    176 {
    177 #if defined(__MINGW32__)
    178   LARGE_INTEGER cnt;
    179   LARGE_INTEGER freq;
    180   bool fail = false;
    181   if (count && !QueryPerformanceCounter (&cnt))
    182     fail = true;
    183   if (count_rate && !QueryPerformanceFrequency (&freq))
    184     fail = true;
    185   if (fail)
    186     {
    187       if (count)
    188 	*count = - GFC_INTEGER_8_HUGE;
    189       if (count_rate)
    190 	*count_rate = 0;
    191       if (count_max)
    192 	*count_max = 0;
    193     }
    194   else
    195     {
    196       if (count)
    197 	*count = cnt.QuadPart;
    198       if (count_rate)
    199 	*count_rate = freq.QuadPart;
    200       if (count_max)
    201 	*count_max = GFC_INTEGER_8_HUGE;
    202     }
    203 #else
    204   time_t secs;
    205   long fracsecs, tck;
    206 
    207   if (gf_gettime_mono (&secs, &fracsecs, &tck) == 0)
    208     {
    209       GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) secs * tck;
    210       ucnt += fracsecs;
    211       if (ucnt > GFC_INTEGER_8_HUGE)
    212 	ucnt = ucnt - GFC_INTEGER_8_HUGE - 1;
    213       if (count)
    214 	*count = ucnt;
    215       if (count_rate)
    216 	*count_rate = tck;
    217       if (count_max)
    218 	*count_max = GFC_INTEGER_8_HUGE;
    219     }
    220   else
    221     {
    222       if (count)
    223 	*count = - GFC_INTEGER_8_HUGE;
    224       if (count_rate)
    225 	*count_rate = 0;
    226       if (count_max)
    227 	*count_max = 0;
    228     }
    229 #endif
    230 }
    231