re PR fortran/55548 (SYSTEM_CLOCK with integer(8) provides nanosecond resolution, but only microsecond precision (without -lrt))

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-12-03  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/55548
	* intrinsic.texi (SYSTEM_CLOCK): Update documentation of SYSTEM_CLOCK.

From-SVN: r194105

4 files changed, 35 insertions, 21 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f6b4fb0..939888e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2012-12-03  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/55548
+	* intrinsic.texi (SYSTEM_CLOCK): Update documentation of SYSTEM_CLOCK.
+
 2012-12-03  Tobias Burnus  <burnus@net-b.de>
 	    Janus Weil  <janus@gcc.gnu.org>
 
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index a8ec1ed..3390959 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -12014,12 +12014,11 @@ nanosecond resolution.  If a high resolution monotonic clock is not
 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.
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 5e59dce..ecaa6e3 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+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.
diff --git a/libgfortran/intrinsics/system_clock.c b/libgfortran/intrinsics/system_clock.c
index 6385c4f..9d5ba52 100644
--- a/libgfortran/intrinsics/system_clock.c
+++ b/libgfortran/intrinsics/system_clock.c
@@ -64,6 +64,7 @@ static int weak_gettime (clockid_t, struct timespec *)
    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
@@ -76,11 +77,12 @@ static int weak_gettime (clockid_t, struct timespec *)
    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;
@@ -90,12 +92,14 @@ gf_gettime_mono (time_t * secs, long * nanosecs)
   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;
@@ -118,21 +122,20 @@ void
 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
@@ -153,7 +156,7 @@ system_clock_4(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
   if (count != NULL)
     *count = cnt;
   if (count_rate != NULL)
-    *count_rate = TCK;
+    *count_rate = tck;
   if (count_max != NULL)
     *count_max = mx;
 }
@@ -165,21 +168,19 @@ void
 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
@@ -201,7 +202,7 @@ system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
   if (count != NULL)
     *count = cnt;
   if (count_rate != NULL)
-    *count_rate = TCK;
+    *count_rate = tck;
   if (count_max != NULL)
     *count_max = mx;
 }