1 /* Implementation of the SYSTEM_CLOCK intrinsic.
2 Copyright (C) 2004-2014 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 fracsecs - OUTPUT, fractional seconds, units given by tk argument
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
gf_gettime_mono(time_t * secs,long * fracsecs,long * tck)82 gf_gettime_mono (time_t * secs, long * fracsecs, 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 *fracsecs = 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 *fracsecs = ts.tv_nsec;
101 return err;
102 }
103 #endif
104 *tck = 1000000;
105 err = gf_gettime (secs, fracsecs);
106 return err;
107 #endif
108 }
109
110 #endif /* !__MINGW32 && !__CYGWIN__ */
111
112 extern void system_clock_4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *);
113 export_proto(system_clock_4);
114
115 extern void system_clock_8 (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *);
116 export_proto(system_clock_8);
117
118
119 /* prefix(system_clock_4) is the INTEGER(4) version of the SYSTEM_CLOCK
120 intrinsic subroutine. It returns the number of clock ticks for the current
121 system time, the number of ticks per second, and the maximum possible value
122 for COUNT. */
123
124 void
system_clock_4(GFC_INTEGER_4 * count,GFC_INTEGER_4 * count_rate,GFC_INTEGER_4 * count_max)125 system_clock_4(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
126 GFC_INTEGER_4 *count_max)
127 {
128 #if defined(__MINGW32__) || defined(__CYGWIN__)
129 if (count)
130 {
131 /* Use GetTickCount here as the resolution and range is
132 sufficient for the INTEGER(kind=4) version, and
133 QueryPerformanceCounter has potential issues. */
134 uint32_t cnt = GetTickCount ();
135 if (cnt > GFC_INTEGER_4_HUGE)
136 cnt = cnt - GFC_INTEGER_4_HUGE - 1;
137 *count = cnt;
138 }
139 if (count_rate)
140 *count_rate = 1000;
141 if (count_max)
142 *count_max = GFC_INTEGER_4_HUGE;
143 #else
144 time_t secs;
145 long fracsecs, tck;
146
147 if (gf_gettime_mono (&secs, &fracsecs, &tck) == 0)
148 {
149 long tck_out = tck > 1000 ? 1000 : tck;
150 long tck_r = tck / tck_out;
151 GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) secs * tck_out;
152 ucnt += fracsecs / tck_r;
153 if (ucnt > GFC_INTEGER_4_HUGE)
154 ucnt = ucnt - GFC_INTEGER_4_HUGE - 1;
155 if (count)
156 *count = ucnt;
157 if (count_rate)
158 *count_rate = tck_out;
159 if (count_max)
160 *count_max = GFC_INTEGER_4_HUGE;
161 }
162 else
163 {
164 if (count)
165 *count = - GFC_INTEGER_4_HUGE;
166 if (count_rate)
167 *count_rate = 0;
168 if (count_max)
169 *count_max = 0;
170 }
171 #endif
172 }
173
174
175 /* INTEGER(8) version of the above routine. */
176
177 void
system_clock_8(GFC_INTEGER_8 * count,GFC_INTEGER_8 * count_rate,GFC_INTEGER_8 * count_max)178 system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
179 GFC_INTEGER_8 *count_max)
180 {
181 #if defined(__MINGW32__) || defined(__CYGWIN__)
182 LARGE_INTEGER cnt;
183 LARGE_INTEGER freq;
184 bool fail = false;
185 if (count && !QueryPerformanceCounter (&cnt))
186 fail = true;
187 if (count_rate && !QueryPerformanceFrequency (&freq))
188 fail = true;
189 if (fail)
190 {
191 if (count)
192 *count = - GFC_INTEGER_8_HUGE;
193 if (count_rate)
194 *count_rate = 0;
195 if (count_max)
196 *count_max = 0;
197 }
198 else
199 {
200 if (count)
201 *count = cnt.QuadPart;
202 if (count_rate)
203 *count_rate = freq.QuadPart;
204 if (count_max)
205 *count_max = GFC_INTEGER_8_HUGE;
206 }
207 #else
208 time_t secs;
209 long fracsecs, tck;
210
211 if (gf_gettime_mono (&secs, &fracsecs, &tck) == 0)
212 {
213 GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) secs * tck;
214 ucnt += fracsecs;
215 if (ucnt > GFC_INTEGER_8_HUGE)
216 ucnt = ucnt - GFC_INTEGER_8_HUGE - 1;
217 if (count)
218 *count = ucnt;
219 if (count_rate)
220 *count_rate = tck;
221 if (count_max)
222 *count_max = GFC_INTEGER_8_HUGE;
223 }
224 else
225 {
226 if (count)
227 *count = - GFC_INTEGER_8_HUGE;
228 if (count_rate)
229 *count_rate = 0;
230 if (count_max)
231 *count_max = 0;
232 }
233 #endif
234 }
235