]>
git.ipfire.org Git - thirdparty/gcc.git/blob - libgfortran/intrinsics/system_clock.c
9d5ba528ce3e102e669d46ee1b3847519973c205
1 /* Implementation of the SYSTEM_CLOCK intrinsic.
2 Copyright (C) 2004, 2005, 2007, 2009, 2010, 2011 Free Software
5 This file is part of the GNU Fortran runtime library (libgfortran).
7 Libgfortran is free software; you can redistribute it and/or
8 modify it under the terms of the GNU General Public
9 License as published by the Free Software Foundation; either
10 version 3 of the License, or (at your option) any later version.
12 Libgfortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
26 #include "libgfortran.h"
33 /* POSIX states that CLOCK_REALTIME must be present if clock_gettime
34 is available, others are optional. */
35 #if defined(HAVE_CLOCK_GETTIME) || defined(HAVE_CLOCK_GETTIME_LIBRT)
36 #ifdef CLOCK_MONOTONIC
37 #define GF_CLOCK_MONOTONIC CLOCK_MONOTONIC
39 #define GF_CLOCK_MONOTONIC CLOCK_REALTIME
43 /* Weakref trickery for clock_gettime(). On Glibc, clock_gettime()
44 requires us to link in librt, which also pulls in libpthread. In
45 order to avoid this by default, only call clock_gettime() through a
48 Some targets don't support weak undefined references; on these
49 GTHREAD_USE_WEAK is 0. So we need to define it to 1 on other
51 #ifndef GTHREAD_USE_WEAK
52 #define GTHREAD_USE_WEAK 1
55 #if SUPPORTS_WEAK && GTHREAD_USE_WEAK && defined(HAVE_CLOCK_GETTIME_LIBRT)
56 static int weak_gettime (clockid_t
, struct timespec
*)
57 __attribute__((__weakref__("clock_gettime")));
61 /* High resolution monotonic clock, falling back to the realtime clock
62 if the target does not support such a clock.
65 secs - OUTPUT, seconds
66 nanosecs - OUTPUT, nanoseconds
67 tk - OUTPUT, clock resolution [counts/sec]
69 If the target supports a monotonic clock, the OUTPUT arguments
70 represent a monotonically incrementing clock starting from some
71 unspecified time in the past.
73 If a monotonic clock is not available, falls back to the realtime
74 clock which is not monotonic.
76 Return value: 0 for success, -1 for error. In case of error, errno
80 gf_gettime_mono (time_t * secs
, long * nanosecs
, long * tck
)
83 #ifdef HAVE_CLOCK_GETTIME
86 err
= clock_gettime (GF_CLOCK_MONOTONIC
, &ts
);
88 *nanosecs
= ts
.tv_nsec
;
91 #if defined(HAVE_CLOCK_GETTIME_LIBRT) && SUPPORTS_WEAK && GTHREAD_USE_WEAK
96 err
= weak_gettime (GF_CLOCK_MONOTONIC
, &ts
);
98 *nanosecs
= ts
.tv_nsec
;
103 err
= gf_gettime (secs
, nanosecs
);
109 extern void system_clock_4 (GFC_INTEGER_4
*, GFC_INTEGER_4
*, GFC_INTEGER_4
*);
110 export_proto(system_clock_4
);
112 extern void system_clock_8 (GFC_INTEGER_8
*, GFC_INTEGER_8
*, GFC_INTEGER_8
*);
113 export_proto(system_clock_8
);
116 /* prefix(system_clock_4) is the INTEGER(4) version of the SYSTEM_CLOCK
117 intrinsic subroutine. It returns the number of clock ticks for the current
118 system time, the number of ticks per second, and the maximum possible value
119 for COUNT. On the first call to SYSTEM_CLOCK, COUNT is set to zero. */
122 system_clock_4(GFC_INTEGER_4
*count
, GFC_INTEGER_4
*count_rate
,
123 GFC_INTEGER_4
*count_max
)
131 if (sizeof (secs
) < sizeof (GFC_INTEGER_4
))
132 internal_error (NULL
, "secs too small");
134 if (gf_gettime_mono (&secs
, &nanosecs
, &tck
) == 0)
136 tck
= tck
>1000 ? 1000 : tck
;
137 GFC_UINTEGER_4 ucnt
= (GFC_UINTEGER_4
) secs
* tck
;
138 ucnt
+= (nanosecs
+ 500000000 / tck
) / (1000000000 / tck
);
139 if (ucnt
> GFC_INTEGER_4_HUGE
)
140 cnt
= ucnt
- GFC_INTEGER_4_HUGE
- 1;
143 mx
= GFC_INTEGER_4_HUGE
;
148 *count
= - GFC_INTEGER_4_HUGE
;
149 if (count_rate
!= NULL
)
151 if (count_max
!= NULL
)
158 if (count_rate
!= NULL
)
160 if (count_max
!= NULL
)
165 /* INTEGER(8) version of the above routine. */
168 system_clock_8 (GFC_INTEGER_8
*count
, GFC_INTEGER_8
*count_rate
,
169 GFC_INTEGER_8
*count_max
)
177 if (sizeof (secs
) < sizeof (GFC_INTEGER_4
))
178 internal_error (NULL
, "secs too small");
180 if (gf_gettime_mono (&secs
, &nanosecs
, &tck
) == 0)
182 GFC_UINTEGER_8 ucnt
= (GFC_UINTEGER_8
) secs
* tck
;
183 ucnt
+= (nanosecs
+ 500000000 / tck
) / (1000000000 / tck
);
184 if (ucnt
> GFC_INTEGER_8_HUGE
)
185 cnt
= ucnt
- GFC_INTEGER_8_HUGE
- 1;
188 mx
= GFC_INTEGER_8_HUGE
;
193 *count
= - GFC_INTEGER_8_HUGE
;
194 if (count_rate
!= NULL
)
196 if (count_max
!= NULL
)
204 if (count_rate
!= NULL
)
206 if (count_max
!= NULL
)