]>
Commit | Line | Data |
---|---|---|
21fdfcc1 | 1 | /* Implementation of the SYSTEM_CLOCK intrinsic. |
cbe34bb5 | 2 | Copyright (C) 2004-2017 Free Software Foundation, Inc. |
21fdfcc1 | 3 | |
a8572b62 | 4 | This file is part of the GNU Fortran runtime library (libgfortran). |
21fdfcc1 SK |
5 | |
6 | Libgfortran is free software; you can redistribute it and/or | |
57dea9f6 | 7 | modify it under the terms of the GNU General Public |
21fdfcc1 | 8 | License as published by the Free Software Foundation; either |
748086b7 | 9 | version 3 of the License, or (at your option) any later version. |
21fdfcc1 SK |
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 | |
57dea9f6 | 14 | GNU General Public License for more details. |
21fdfcc1 | 15 | |
748086b7 JJ |
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/>. */ | |
21fdfcc1 | 24 | |
21fdfcc1 SK |
25 | #include "libgfortran.h" |
26 | ||
27 | #include <limits.h> | |
28 | ||
b6e7a3d1 | 29 | #include "time_1.h" |
21fdfcc1 | 30 | |
2aadeae2 | 31 | |
83584eab JB |
32 | #if !defined(__MINGW32__) && !defined(__CYGWIN__) |
33 | ||
02b17751 JB |
34 | /* POSIX states that CLOCK_REALTIME must be present if clock_gettime |
35 | is available, others are optional. */ | |
2aadeae2 | 36 | #if defined(HAVE_CLOCK_GETTIME) || defined(HAVE_CLOCK_GETTIME_LIBRT) |
83584eab JB |
37 | #if defined(CLOCK_MONOTONIC) && defined(_POSIX_MONOTONIC_CLOCK) \ |
38 | && _POSIX_MONOTONIC_CLOCK >= 0 | |
02b17751 JB |
39 | #define GF_CLOCK_MONOTONIC CLOCK_MONOTONIC |
40 | #else | |
41 | #define GF_CLOCK_MONOTONIC CLOCK_REALTIME | |
42 | #endif | |
2aadeae2 | 43 | #endif |
02b17751 | 44 | |
83584eab JB |
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 | |
e7854993 FXC |
48 | clock_gettime() through a weak reference. */ |
49 | #if SUPPORTS_WEAKREF && defined(HAVE_CLOCK_GETTIME_LIBRT) | |
02b17751 JB |
50 | static int weak_gettime (clockid_t, struct timespec *) |
51 | __attribute__((__weakref__("clock_gettime"))); | |
02b17751 JB |
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 | |
96cc0ef4 | 60 | fracsecs - OUTPUT, fractional seconds, units given by tk argument |
a07c4054 | 61 | tk - OUTPUT, clock resolution [counts/sec] |
02b17751 JB |
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 | */ | |
992b0aa1 | 73 | static int |
96cc0ef4 | 74 | gf_gettime_mono (time_t * secs, long * fracsecs, long * tck) |
02b17751 JB |
75 | { |
76 | int err; | |
77 | #ifdef HAVE_CLOCK_GETTIME | |
2aadeae2 | 78 | struct timespec ts; |
a07c4054 | 79 | *tck = 1000000000; |
2aadeae2 JB |
80 | err = clock_gettime (GF_CLOCK_MONOTONIC, &ts); |
81 | *secs = ts.tv_sec; | |
96cc0ef4 | 82 | *fracsecs = ts.tv_nsec; |
2aadeae2 JB |
83 | return err; |
84 | #else | |
e7854993 | 85 | #if SUPPORTS_WEAKREF && defined(HAVE_CLOCK_GETTIME_LIBRT) |
02b17751 JB |
86 | if (weak_gettime) |
87 | { | |
88 | struct timespec ts; | |
a07c4054 | 89 | *tck = 1000000000; |
02b17751 JB |
90 | err = weak_gettime (GF_CLOCK_MONOTONIC, &ts); |
91 | *secs = ts.tv_sec; | |
96cc0ef4 | 92 | *fracsecs = ts.tv_nsec; |
02b17751 JB |
93 | return err; |
94 | } | |
95 | #endif | |
a07c4054 | 96 | *tck = 1000000; |
96cc0ef4 | 97 | err = gf_gettime (secs, fracsecs); |
02b17751 | 98 | return err; |
2aadeae2 | 99 | #endif |
02b17751 JB |
100 | } |
101 | ||
83584eab JB |
102 | #endif /* !__MINGW32 && !__CYGWIN__ */ |
103 | ||
d4b35ef7 JD |
104 | extern void |
105 | system_clock_4 (GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate, | |
106 | GFC_INTEGER_4 *count_max); | |
7d7b8bfe RH |
107 | export_proto(system_clock_4); |
108 | ||
d4b35ef7 JD |
109 | extern void |
110 | system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, | |
111 | GFC_INTEGER_8 *count_max); | |
7d7b8bfe RH |
112 | export_proto(system_clock_8); |
113 | ||
114 | ||
21fdfcc1 SK |
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 | |
83584eab | 118 | for COUNT. */ |
21fdfcc1 SK |
119 | |
120 | void | |
d4b35ef7 | 121 | system_clock_4 (GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate, |
7d7b8bfe | 122 | GFC_INTEGER_4 *count_max) |
21fdfcc1 | 123 | { |
d4b35ef7 | 124 | #if defined(__MINGW32__) || defined(__CYGWIN__) |
83584eab JB |
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) | |
a2f7b4ad | 132 | cnt = cnt - GFC_INTEGER_4_HUGE - 1; |
83584eab JB |
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 | |
b6e7a3d1 | 140 | time_t secs; |
96cc0ef4 | 141 | long fracsecs, tck; |
21fdfcc1 | 142 | |
96cc0ef4 | 143 | if (gf_gettime_mono (&secs, &fracsecs, &tck) == 0) |
21fdfcc1 | 144 | { |
96cc0ef4 JB |
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; | |
5e805e44 | 149 | if (ucnt > GFC_INTEGER_4_HUGE) |
96cc0ef4 JB |
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; | |
21fdfcc1 SK |
157 | } |
158 | else | |
159 | { | |
96cc0ef4 | 160 | if (count) |
6b021536 | 161 | *count = - GFC_INTEGER_4_HUGE; |
96cc0ef4 | 162 | if (count_rate) |
6b021536 | 163 | *count_rate = 0; |
96cc0ef4 | 164 | if (count_max) |
6b021536 | 165 | *count_max = 0; |
21fdfcc1 | 166 | } |
83584eab | 167 | #endif |
21fdfcc1 SK |
168 | } |
169 | ||
170 | ||
171 | /* INTEGER(8) version of the above routine. */ | |
172 | ||
173 | void | |
7d7b8bfe | 174 | system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, |
d4b35ef7 | 175 | GFC_INTEGER_8 *count_max) |
21fdfcc1 | 176 | { |
83584eab JB |
177 | #if defined(__MINGW32__) || defined(__CYGWIN__) |
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 | |
b6e7a3d1 | 204 | time_t secs; |
96cc0ef4 | 205 | long fracsecs, tck; |
5e805e44 | 206 | |
96cc0ef4 | 207 | if (gf_gettime_mono (&secs, &fracsecs, &tck) == 0) |
21fdfcc1 | 208 | { |
a07c4054 | 209 | GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) secs * tck; |
96cc0ef4 | 210 | ucnt += fracsecs; |
b6e7a3d1 | 211 | if (ucnt > GFC_INTEGER_8_HUGE) |
96cc0ef4 JB |
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; | |
21fdfcc1 SK |
219 | } |
220 | else | |
221 | { | |
96cc0ef4 | 222 | if (count) |
6b021536 | 223 | *count = - GFC_INTEGER_8_HUGE; |
96cc0ef4 | 224 | if (count_rate) |
6b021536 | 225 | *count_rate = 0; |
96cc0ef4 | 226 | if (count_max) |
6b021536 | 227 | *count_max = 0; |
21fdfcc1 | 228 | } |
83584eab | 229 | #endif |
21fdfcc1 | 230 | } |