libgfortran/intrinsics/system_clock.c

   1 /* Implementation of the SYSTEM_CLOCK intrinsic.
   2    Copyright (C) 2004 Free Software Foundation, Inc.
   3
   4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   5
   6 Libgfortran is free software; you can redistribute it and/or
   7 modify it under the terms of the GNU Lesser General Public
   8 License as published by the Free Software Foundation; either
   9 version 2.1 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 Lesser General Public License for more details.
  15
  16 You should have received a copy of the GNU Lesser General Public
  17 License along with libgfortran; see the file COPYING.LIB.  If not,
  18 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 #include "config.h"
  22 #include <sys/types.h>
  23 #include "libgfortran.h"
  24
  25 #include <limits.h>
  26
  27 #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
  28 #  include <sys/time.h>
  29 #  define TCK 1000
  30 #elif defined(HAVE_TIME_H)
  31 #  include <time.h>
  32 #  define TCK 1
  33 #else
  34 #define TCK 0
  35 #endif
  36
  37
  38 #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
  39 static struct timeval tp0 = {-1, 0};
  40 #elif defined(HAVE_TIME_H)
  41 static time_t t0 = (time_t) -2;
  42 #endif
  43
  44 /* prefix(system_clock_4) is the INTEGER(4) version of the SYSTEM_CLOCK
  45    intrinsic subroutine.  It returns the number of clock ticks for the current
  46    system time, the number of ticks per second, and the maximum possible value
  47    for COUNT.  On the first call to SYSTEM_CLOCK, COUNT is set to zero. */
  48
  49 void
  50 prefix(system_clock_4)(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
  51                        GFC_INTEGER_4 *count_max)
  52 {
  53   GFC_INTEGER_4 cnt;
  54   GFC_INTEGER_4 rate;
  55   GFC_INTEGER_4 mx;
  56
  57 #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
  58   struct timeval tp1;
  59   struct timezone tzp;
  60   double t;
  61
  62   if (gettimeofday(&tp1, &tzp) == 0)
  63     {
  64       if (tp0.tv_sec < 0)
  65         {
  66           tp0 = tp1;
  67           cnt = 0;
  68         }
  69       else
  70         {
  71           /* TODO: Convert this to integer arithmetic.  */
  72           t  = (double) (tp1.tv_sec  - tp0.tv_sec);
  73           t += (double) (tp1.tv_usec - tp0.tv_usec) * 1.e-6;
  74           t *= TCK;
  75
  76           if (t > (double) GFC_INTEGER_4_HUGE)
  77             {
  78               /* Time has wrapped. */
  79               while (t > (double) GFC_INTEGER_4_HUGE)
  80                 t -= (double) GFC_INTEGER_4_HUGE;
  81               tp0 = tp1;
  82             }
  83           cnt = (GFC_INTEGER_4) t;
  84         }
  85       rate = TCK;
  86       mx = GFC_INTEGER_4_HUGE;
  87     }
  88   else
  89     {
  90       if (count != NULL) *count = - GFC_INTEGER_4_HUGE;
  91       if (count_rate != NULL) *count_rate = 0;
  92       if (count_max != NULL) *count_max = 0;
  93     }
  94 #elif defined(HAVE_TIME_H)
  95   time_t t, t1;
  96
  97   t1 = time(NULL);
  98
  99   if (t1 == (time_t) -1)
 100     {
 101       cnt = - GFC_INTEGER_4_HUGE;
 102       mx = 0;
 103     }
 104   else if (t0 == (time_t) -2)
 105     t0 = t1;
 106   else
 107     {
 108       /* The timer counts in seconts, so for simplicity assume it never wraps.
 109          Even with 32-bit counters this only happens once every 68 years.  */
 110       cnt = t1 - t0;
 111       mx = GFC_INTEGER_4_HUGE;
 112     }
 113 #else
 114   cnt = - GFC_INTEGER_4_HUGE;
 115   mx = 0;
 116 #endif
 117   if (count != NULL) *count = cnt;
 118   if (count_rate != NULL) *count_rate = TCK;
 119   if (count_max != NULL) *count_max = mx;
 120 }
 121
 122
 123 /* INTEGER(8) version of the above routine.  */
 124
 125 void
 126 prefix(system_clock_8)(GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
 127                        GFC_INTEGER_8 *count_max)
 128 {
 129   GFC_INTEGER_8 cnt;
 130   GFC_INTEGER_8 rate;
 131   GFC_INTEGER_8 mx;
 132
 133 #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
 134   struct timeval tp1;
 135   struct timezone tzp;
 136   double t;
 137
 138   if (gettimeofday(&tp1, &tzp) == 0)
 139     {
 140       if (tp0.tv_sec < 0)
 141         {
 142           tp0 = tp1;
 143           cnt = 0;
 144         }
 145       else
 146         {
 147           /* TODO: Convert this to integer arithmetic.  */
 148           t  = (double) (tp1.tv_sec  - tp0.tv_sec);
 149           t += (double) (tp1.tv_usec - tp0.tv_usec) * 1.e-6;
 150           t *= TCK;
 151
 152           if (t > (double) GFC_INTEGER_8_HUGE)
 153             {
 154               /* Time has wrapped. */
 155               while (t > (double) GFC_INTEGER_8_HUGE)
 156                 t -= (double) GFC_INTEGER_8_HUGE;
 157               tp0 = tp1;
 158             }
 159           cnt = (GFC_INTEGER_8) t;
 160         }
 161       rate = TCK;
 162       mx = GFC_INTEGER_8_HUGE;
 163     }
 164   else
 165     {
 166       if (count != NULL) *count = - GFC_INTEGER_8_HUGE;
 167       if (count_rate != NULL) *count_rate = 0;
 168       if (count_max != NULL) *count_max = 0;
 169     }
 170 #elif defined(HAVE_TIME_H)
 171   time_t t, t1;
 172
 173   t1 = time(NULL);
 174
 175   if (t1 == (time_t) -1)
 176     {
 177       cnt = - GFC_INTEGER_8_HUGE;
 178       mx = 0;
 179     }
 180   else if (t0 == (time_t) -2)
 181     t0 = t1;
 182   else
 183     {
 184       /* The timer counts in seconts, so for simplicity assume it never wraps.
 185          Even with 32-bit counters this only happens once every 68 years.  */
 186       cnt = t1 - t0;
 187       mx = GFC_INTEGER_8_HUGE;
 188     }
 189 #else
 190   cnt = - GFC_INTEGER_8_HUGE;
 191   mx = 0;
 192 #endif
 193   if (count != NULL)
 194     *count = cnt;
 195   if (count_rate != NULL)
 196     *count_rate = TCK;
 197   if (count_max != NULL)
 198     *count_max = mx;
 199 }
 200