1 /* Implementation of the SYSTEM_CLOCK intrinsic.
2 Copyright (C) 2004-2023 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 }