]>
Commit | Line | Data |
---|---|---|
041de113 | 1 | /* Implementation of the DATE_AND_TIME intrinsic. |
fbd26352 | 2 | Copyright (C) 2003-2019 Free Software Foundation, Inc. |
041de113 | 3 | Contributed by Steven Bosscher. |
4 | ||
5e62a3cc | 5 | This file is part of the GNU Fortran runtime library (libgfortran). |
041de113 | 6 | |
b417ea8c | 7 | Libgfortran is free software; you can redistribute it and/or |
8 | modify it under the terms of the GNU General Public | |
041de113 | 9 | License as published by the Free Software Foundation; either |
6bc9506f | 10 | version 3 of the License, or (at your option) any later version. |
b417ea8c | 11 | |
12 | Libgfortran is distributed in the hope that it will be useful, | |
041de113 | 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
b417ea8c | 15 | GNU General Public License for more details. |
041de113 | 16 | |
6bc9506f | 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. | |
20 | ||
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/>. */ | |
041de113 | 25 | |
41f2d5e8 | 26 | #include "libgfortran.h" |
041de113 | 27 | #include <string.h> |
28 | #include <assert.h> | |
041de113 | 29 | |
a2c0dc0f | 30 | #include "time_1.h" |
041de113 | 31 | |
eaae6999 | 32 | |
bacb1fe3 | 33 | /* If the re-entrant version of gmtime is not available, provide a |
34 | fallback implementation. On some targets where the _r version is | |
35 | not available, gmtime uses thread-local storage so it's | |
36 | threadsafe. */ | |
eaae6999 | 37 | |
38 | #ifndef HAVE_GMTIME_R | |
9e09cd23 | 39 | /* If _POSIX is defined gmtime_r gets defined by mingw-w64 headers. */ |
40 | #ifdef gmtime_r | |
41 | #undef gmtime_r | |
42 | #endif | |
43 | ||
eaae6999 | 44 | static struct tm * |
45 | gmtime_r (const time_t * timep, struct tm * result) | |
46 | { | |
47 | *result = *gmtime (timep); | |
48 | return result; | |
49 | } | |
50 | #endif | |
51 | ||
52 | ||
041de113 | 53 | /* DATE_AND_TIME ([DATE, TIME, ZONE, VALUES]) |
54 | ||
55 | Description: Returns data on the real-time clock and date in a form | |
56 | compatible with the representations defined in ISO 8601:1988. | |
57 | ||
58 | Class: Non-elemental subroutine. | |
59 | ||
60 | Arguments: | |
61 | ||
49c0e9db | 62 | DATE (optional) shall be scalar and of type default character. |
63 | It is an INTENT(OUT) argument. It is assigned a value of the | |
64 | form CCYYMMDD, where CC is the century, YY the year within the | |
65 | century, MM the month within the year, and DD the day within the | |
66 | month. If there is no date available, they are assigned blanks. | |
67 | ||
68 | TIME (optional) shall be scalar and of type default character. | |
69 | It is an INTENT(OUT) argument. It is assigned a value of the | |
70 | form hhmmss.sss, where hh is the hour of the day, mm is the | |
71 | minutes of the hour, and ss.sss is the seconds and milliseconds | |
72 | of the minute. If there is no clock available, they are assigned | |
73 | blanks. | |
74 | ||
75 | ZONE (optional) shall be scalar and of type default character. | |
76 | It is an INTENT(OUT) argument. It is assigned a value of the | |
77 | form [+-]hhmm, where hh and mm are the time difference with | |
78 | respect to Coordinated Universal Time (UTC) in hours and parts | |
79 | of an hour expressed in minutes, respectively. If there is no | |
80 | clock available, they are assigned blanks. | |
041de113 | 81 | |
82 | VALUES (optional) shall be of type default integer and of rank | |
9a5f3765 | 83 | one. It is an INTENT(OUT) argument. Its size shall be at least |
041de113 | 84 | 8. The values returned in VALUES are as follows: |
85 | ||
9a5f3765 | 86 | VALUES(1) the year (for example, 2003), or -HUGE(0) if there is |
041de113 | 87 | no date available; |
88 | ||
9a5f3765 | 89 | VALUES(2) the month of the year, or -HUGE(0) if there |
041de113 | 90 | is no date available; |
91 | ||
9a5f3765 | 92 | VALUES(3) the day of the month, or -HUGE(0) if there is no date |
041de113 | 93 | available; |
94 | ||
9a5f3765 | 95 | VALUES(4) the time difference with respect to Coordinated |
96 | Universal Time (UTC) in minutes, or -HUGE(0) if this information | |
041de113 | 97 | is not available; |
98 | ||
9a5f3765 | 99 | VALUES(5) the hour of the day, in the range of 0 to 23, or |
100 | -HUGE(0) if there is no clock; | |
041de113 | 101 | |
9a5f3765 | 102 | VALUES(6) the minutes of the hour, in the range 0 to 59, or |
103 | -HUGE(0) if there is no clock; | |
041de113 | 104 | |
9a5f3765 | 105 | VALUES(7) the seconds of the minute, in the range 0 to 60, or |
106 | -HUGE(0) if there is no clock; | |
041de113 | 107 | |
9a5f3765 | 108 | VALUES(8) the milliseconds of the second, in the range 0 to |
109 | 999, or -HUGE(0) if there is no clock. | |
041de113 | 110 | |
111 | NULL pointer represent missing OPTIONAL arguments. All arguments | |
112 | have INTENT(OUT). Because of the -i8 option, we must implement | |
113 | VALUES for INTEGER(kind=4) and INTEGER(kind=8). | |
114 | ||
115 | Based on libU77's date_time_.c. | |
116 | ||
117 | TODO : | |
118 | - Check year boundaries. | |
041de113 | 119 | */ |
9a5f3765 | 120 | #define DATE_LEN 8 |
121 | #define TIME_LEN 10 | |
122 | #define ZONE_LEN 5 | |
123 | #define VALUES_SIZE 8 | |
041de113 | 124 | |
7b6cb5bd | 125 | extern void date_and_time (char *, char *, char *, gfc_array_i4 *, |
126 | GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4); | |
127 | export_proto(date_and_time); | |
128 | ||
041de113 | 129 | void |
9a5f3765 | 130 | date_and_time (char *__date, char *__time, char *__zone, |
131 | gfc_array_i4 *__values, GFC_INTEGER_4 __date_len, | |
132 | GFC_INTEGER_4 __time_len, GFC_INTEGER_4 __zone_len) | |
041de113 | 133 | { |
9a5f3765 | 134 | int i; |
041de113 | 135 | char date[DATE_LEN + 1]; |
136 | char timec[TIME_LEN + 1]; | |
137 | char zone[ZONE_LEN + 1]; | |
138 | GFC_INTEGER_4 values[VALUES_SIZE]; | |
139 | ||
9a5f3765 | 140 | time_t lt; |
141 | struct tm local_time; | |
142 | struct tm UTC_time; | |
143 | ||
f2c8d53a | 144 | long usecs; |
a2c0dc0f | 145 | |
f2c8d53a | 146 | if (!gf_gettime (<, &usecs)) |
9a5f3765 | 147 | { |
f2c8d53a | 148 | values[7] = usecs / 1000; |
a2c0dc0f | 149 | |
eaae6999 | 150 | localtime_r (<, &local_time); |
151 | gmtime_r (<, &UTC_time); | |
9a5f3765 | 152 | |
153 | /* All arguments can be derived from VALUES. */ | |
154 | values[0] = 1900 + local_time.tm_year; | |
155 | values[1] = 1 + local_time.tm_mon; | |
156 | values[2] = local_time.tm_mday; | |
157 | values[3] = (local_time.tm_min - UTC_time.tm_min + | |
158 | 60 * (local_time.tm_hour - UTC_time.tm_hour + | |
041de113 | 159 | 24 * (local_time.tm_yday - UTC_time.tm_yday))); |
9a5f3765 | 160 | values[4] = local_time.tm_hour; |
161 | values[5] = local_time.tm_min; | |
162 | values[6] = local_time.tm_sec; | |
041de113 | 163 | |
9a5f3765 | 164 | if (__date) |
165 | snprintf (date, DATE_LEN + 1, "%04d%02d%02d", | |
166 | values[0], values[1], values[2]); | |
167 | if (__time) | |
168 | snprintf (timec, TIME_LEN + 1, "%02d%02d%02d.%03d", | |
169 | values[4], values[5], values[6], values[7]); | |
170 | ||
171 | if (__zone) | |
172 | snprintf (zone, ZONE_LEN + 1, "%+03d%02d", | |
173 | values[3] / 60, abs (values[3] % 60)); | |
041de113 | 174 | } |
9a5f3765 | 175 | else |
041de113 | 176 | { |
041de113 | 177 | memset (date, ' ', DATE_LEN); |
178 | date[DATE_LEN] = '\0'; | |
179 | ||
180 | memset (timec, ' ', TIME_LEN); | |
9a5f3765 | 181 | timec[TIME_LEN] = '\0'; |
041de113 | 182 | |
183 | memset (zone, ' ', ZONE_LEN); | |
184 | zone[ZONE_LEN] = '\0'; | |
185 | ||
186 | for (i = 0; i < VALUES_SIZE; i++) | |
9a5f3765 | 187 | values[i] = - GFC_INTEGER_4_HUGE; |
188 | } | |
041de113 | 189 | |
190 | /* Copy the values into the arguments. */ | |
191 | if (__values) | |
192 | { | |
e2b80761 | 193 | index_type len, delta, elt_size; |
041de113 | 194 | |
195 | elt_size = GFC_DESCRIPTOR_SIZE (__values); | |
827aef63 | 196 | len = GFC_DESCRIPTOR_EXTENT(__values,0); |
197 | delta = GFC_DESCRIPTOR_STRIDE(__values,0); | |
041de113 | 198 | if (delta == 0) |
199 | delta = 1; | |
99de6824 | 200 | |
201 | if (unlikely (len < VALUES_SIZE)) | |
202 | runtime_error ("Incorrect extent in VALUE argument to" | |
203 | " DATE_AND_TIME intrinsic: is %ld, should" | |
204 | " be >=%ld", (long int) len, (long int) VALUES_SIZE); | |
041de113 | 205 | |
041de113 | 206 | /* Cope with different type kinds. */ |
207 | if (elt_size == 4) | |
208 | { | |
553877d9 | 209 | GFC_INTEGER_4 *vptr4 = __values->base_addr; |
041de113 | 210 | |
211 | for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta) | |
9a5f3765 | 212 | *vptr4 = values[i]; |
041de113 | 213 | } |
214 | else if (elt_size == 8) | |
215 | { | |
553877d9 | 216 | GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->base_addr; |
041de113 | 217 | |
218 | for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta) | |
219 | { | |
9a5f3765 | 220 | if (values[i] == - GFC_INTEGER_4_HUGE) |
221 | *vptr8 = - GFC_INTEGER_8_HUGE; | |
041de113 | 222 | else |
223 | *vptr8 = values[i]; | |
224 | } | |
225 | } | |
226 | else | |
227 | abort (); | |
228 | } | |
229 | ||
230 | if (__zone) | |
49c0e9db | 231 | fstrcpy (__zone, __zone_len, zone, ZONE_LEN); |
041de113 | 232 | |
233 | if (__time) | |
49c0e9db | 234 | fstrcpy (__time, __time_len, timec, TIME_LEN); |
041de113 | 235 | |
236 | if (__date) | |
49c0e9db | 237 | fstrcpy (__date, __date_len, date, DATE_LEN); |
041de113 | 238 | } |
10387833 | 239 | |
240 | ||
241 | /* SECNDS (X) - Non-standard | |
242 | ||
243 | Description: Returns the system time of day, or elapsed time, as a GFC_REAL_4 | |
244 | in seconds. | |
245 | ||
246 | Class: Non-elemental subroutine. | |
247 | ||
248 | Arguments: | |
249 | ||
250 | X must be REAL(4) and the result is of the same type. The accuracy is system | |
251 | dependent. | |
252 | ||
253 | Usage: | |
254 | ||
255 | T = SECNDS (X) | |
256 | ||
257 | yields the time in elapsed seconds since X. If X is 0.0, T is the time in | |
258 | seconds since midnight. Note that a time that spans midnight but is less than | |
259 | 24hours will be calculated correctly. */ | |
260 | ||
261 | extern GFC_REAL_4 secnds (GFC_REAL_4 *); | |
262 | export_proto(secnds); | |
263 | ||
264 | GFC_REAL_4 | |
265 | secnds (GFC_REAL_4 *x) | |
266 | { | |
267 | GFC_INTEGER_4 values[VALUES_SIZE]; | |
268 | GFC_REAL_4 temp1, temp2; | |
269 | ||
6fae9f17 | 270 | /* Make the INTEGER*4 array for passing to date_and_time, with enough space |
271 | for a rank-one array. */ | |
272 | gfc_array_i4 *avalues = xmalloc (sizeof (gfc_array_i4) | |
273 | + sizeof (descriptor_dimension)); | |
553877d9 | 274 | avalues->base_addr = &values[0]; |
d9c7c3e3 | 275 | GFC_DESCRIPTOR_DTYPE (avalues).type = BT_REAL; |
276 | GFC_DESCRIPTOR_DTYPE (avalues).elem_len = 4; | |
277 | GFC_DESCRIPTOR_DTYPE (avalues).rank = 1; | |
827aef63 | 278 | GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1); |
10387833 | 279 | |
280 | date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0); | |
281 | ||
5e62a3cc | 282 | free (avalues); |
10387833 | 283 | |
284 | temp1 = 3600.0 * (GFC_REAL_4)values[4] + | |
285 | 60.0 * (GFC_REAL_4)values[5] + | |
286 | (GFC_REAL_4)values[6] + | |
287 | 0.001 * (GFC_REAL_4)values[7]; | |
288 | temp2 = fmod (*x, 86400.0); | |
df862fe1 | 289 | temp2 = (temp1 - temp2 >= 0.0) ? temp2 : (temp2 - 86400.0); |
10387833 | 290 | return temp1 - temp2; |
291 | } | |
a8a6baf6 | 292 | |
293 | ||
294 | ||
295 | /* ITIME(X) - Non-standard | |
296 | ||
297 | Description: Returns the current local time hour, minutes, and seconds | |
298 | in elements 1, 2, and 3 of X, respectively. */ | |
299 | ||
300 | static void | |
301 | itime0 (int x[3]) | |
302 | { | |
a8a6baf6 | 303 | time_t lt; |
304 | struct tm local_time; | |
305 | ||
306 | lt = time (NULL); | |
307 | ||
308 | if (lt != (time_t) -1) | |
309 | { | |
eaae6999 | 310 | localtime_r (<, &local_time); |
a8a6baf6 | 311 | |
312 | x[0] = local_time.tm_hour; | |
313 | x[1] = local_time.tm_min; | |
314 | x[2] = local_time.tm_sec; | |
315 | } | |
a8a6baf6 | 316 | } |
317 | ||
318 | extern void itime_i4 (gfc_array_i4 *); | |
319 | export_proto(itime_i4); | |
320 | ||
321 | void | |
322 | itime_i4 (gfc_array_i4 *__values) | |
323 | { | |
324 | int x[3], i; | |
e2b80761 | 325 | index_type len, delta; |
a8a6baf6 | 326 | GFC_INTEGER_4 *vptr; |
327 | ||
328 | /* Call helper function. */ | |
329 | itime0(x); | |
330 | ||
331 | /* Copy the value into the array. */ | |
827aef63 | 332 | len = GFC_DESCRIPTOR_EXTENT(__values,0); |
a8a6baf6 | 333 | assert (len >= 3); |
827aef63 | 334 | delta = GFC_DESCRIPTOR_STRIDE(__values,0); |
a8a6baf6 | 335 | if (delta == 0) |
336 | delta = 1; | |
337 | ||
553877d9 | 338 | vptr = __values->base_addr; |
a8a6baf6 | 339 | for (i = 0; i < 3; i++, vptr += delta) |
340 | *vptr = x[i]; | |
341 | } | |
342 | ||
343 | ||
344 | extern void itime_i8 (gfc_array_i8 *); | |
345 | export_proto(itime_i8); | |
346 | ||
347 | void | |
348 | itime_i8 (gfc_array_i8 *__values) | |
349 | { | |
350 | int x[3], i; | |
e2b80761 | 351 | index_type len, delta; |
a8a6baf6 | 352 | GFC_INTEGER_8 *vptr; |
353 | ||
354 | /* Call helper function. */ | |
355 | itime0(x); | |
356 | ||
357 | /* Copy the value into the array. */ | |
827aef63 | 358 | len = GFC_DESCRIPTOR_EXTENT(__values,0); |
a8a6baf6 | 359 | assert (len >= 3); |
827aef63 | 360 | delta = GFC_DESCRIPTOR_STRIDE(__values,0); |
a8a6baf6 | 361 | if (delta == 0) |
362 | delta = 1; | |
363 | ||
553877d9 | 364 | vptr = __values->base_addr; |
a8a6baf6 | 365 | for (i = 0; i < 3; i++, vptr += delta) |
366 | *vptr = x[i]; | |
367 | } | |
368 | ||
369 | ||
370 | ||
371 | /* IDATE(X) - Non-standard | |
372 | ||
373 | Description: Fills TArray with the numerical values at the current | |
374 | local time. The day (in the range 1-31), month (in the range 1-12), | |
375 | and year appear in elements 1, 2, and 3 of X, respectively. | |
376 | The year has four significant digits. */ | |
377 | ||
378 | static void | |
379 | idate0 (int x[3]) | |
380 | { | |
a8a6baf6 | 381 | time_t lt; |
382 | struct tm local_time; | |
383 | ||
384 | lt = time (NULL); | |
385 | ||
386 | if (lt != (time_t) -1) | |
387 | { | |
eaae6999 | 388 | localtime_r (<, &local_time); |
a8a6baf6 | 389 | |
390 | x[0] = local_time.tm_mday; | |
391 | x[1] = 1 + local_time.tm_mon; | |
392 | x[2] = 1900 + local_time.tm_year; | |
393 | } | |
a8a6baf6 | 394 | } |
395 | ||
396 | extern void idate_i4 (gfc_array_i4 *); | |
397 | export_proto(idate_i4); | |
398 | ||
399 | void | |
400 | idate_i4 (gfc_array_i4 *__values) | |
401 | { | |
402 | int x[3], i; | |
e2b80761 | 403 | index_type len, delta; |
a8a6baf6 | 404 | GFC_INTEGER_4 *vptr; |
405 | ||
406 | /* Call helper function. */ | |
407 | idate0(x); | |
408 | ||
409 | /* Copy the value into the array. */ | |
827aef63 | 410 | len = GFC_DESCRIPTOR_EXTENT(__values,0); |
a8a6baf6 | 411 | assert (len >= 3); |
827aef63 | 412 | delta = GFC_DESCRIPTOR_STRIDE(__values,0); |
a8a6baf6 | 413 | if (delta == 0) |
414 | delta = 1; | |
415 | ||
553877d9 | 416 | vptr = __values->base_addr; |
a8a6baf6 | 417 | for (i = 0; i < 3; i++, vptr += delta) |
418 | *vptr = x[i]; | |
419 | } | |
420 | ||
421 | ||
422 | extern void idate_i8 (gfc_array_i8 *); | |
423 | export_proto(idate_i8); | |
424 | ||
425 | void | |
426 | idate_i8 (gfc_array_i8 *__values) | |
427 | { | |
428 | int x[3], i; | |
e2b80761 | 429 | index_type len, delta; |
a8a6baf6 | 430 | GFC_INTEGER_8 *vptr; |
431 | ||
432 | /* Call helper function. */ | |
433 | idate0(x); | |
434 | ||
435 | /* Copy the value into the array. */ | |
827aef63 | 436 | len = GFC_DESCRIPTOR_EXTENT(__values,0); |
a8a6baf6 | 437 | assert (len >= 3); |
827aef63 | 438 | delta = GFC_DESCRIPTOR_STRIDE(__values,0); |
a8a6baf6 | 439 | if (delta == 0) |
440 | delta = 1; | |
441 | ||
553877d9 | 442 | vptr = __values->base_addr; |
a8a6baf6 | 443 | for (i = 0; i < 3; i++, vptr += delta) |
444 | *vptr = x[i]; | |
445 | } | |
d2fc5bb1 | 446 | |
447 | ||
448 | ||
449 | /* GMTIME(STIME, TARRAY) - Non-standard | |
450 | ||
451 | Description: Given a system time value STime, fills TArray with values | |
eaae6999 | 452 | extracted from it appropriate to the GMT time zone using gmtime_r(3). |
d2fc5bb1 | 453 | |
454 | The array elements are as follows: | |
455 | ||
456 | 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds | |
457 | 2. Minutes after the hour, range 0-59 | |
458 | 3. Hours past midnight, range 0-23 | |
dc31fb88 | 459 | 4. Day of month, range 1-31 |
d2fc5bb1 | 460 | 5. Number of months since January, range 0-11 |
461 | 6. Years since 1900 | |
462 | 7. Number of days since Sunday, range 0-6 | |
dc31fb88 | 463 | 8. Days since January 1, range 0-365 |
d2fc5bb1 | 464 | 9. Daylight savings indicator: positive if daylight savings is in effect, |
465 | zero if not, and negative if the information isn't available. */ | |
466 | ||
467 | static void | |
468 | gmtime_0 (const time_t * t, int x[9]) | |
469 | { | |
470 | struct tm lt; | |
471 | ||
eaae6999 | 472 | gmtime_r (t, <); |
d2fc5bb1 | 473 | x[0] = lt.tm_sec; |
474 | x[1] = lt.tm_min; | |
475 | x[2] = lt.tm_hour; | |
476 | x[3] = lt.tm_mday; | |
477 | x[4] = lt.tm_mon; | |
478 | x[5] = lt.tm_year; | |
479 | x[6] = lt.tm_wday; | |
480 | x[7] = lt.tm_yday; | |
481 | x[8] = lt.tm_isdst; | |
482 | } | |
483 | ||
484 | extern void gmtime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *); | |
485 | export_proto(gmtime_i4); | |
486 | ||
487 | void | |
488 | gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) | |
489 | { | |
490 | int x[9], i; | |
e2b80761 | 491 | index_type len, delta; |
d2fc5bb1 | 492 | GFC_INTEGER_4 *vptr; |
493 | time_t tt; | |
494 | ||
495 | /* Call helper function. */ | |
496 | tt = (time_t) *t; | |
497 | gmtime_0(&tt, x); | |
498 | ||
499 | /* Copy the values into the array. */ | |
827aef63 | 500 | len = GFC_DESCRIPTOR_EXTENT(tarray,0); |
d2fc5bb1 | 501 | assert (len >= 9); |
827aef63 | 502 | delta = GFC_DESCRIPTOR_STRIDE(tarray,0); |
d2fc5bb1 | 503 | if (delta == 0) |
504 | delta = 1; | |
505 | ||
553877d9 | 506 | vptr = tarray->base_addr; |
d2fc5bb1 | 507 | for (i = 0; i < 9; i++, vptr += delta) |
508 | *vptr = x[i]; | |
509 | } | |
510 | ||
511 | extern void gmtime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *); | |
512 | export_proto(gmtime_i8); | |
513 | ||
514 | void | |
515 | gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) | |
516 | { | |
517 | int x[9], i; | |
e2b80761 | 518 | index_type len, delta; |
d2fc5bb1 | 519 | GFC_INTEGER_8 *vptr; |
520 | time_t tt; | |
521 | ||
522 | /* Call helper function. */ | |
523 | tt = (time_t) *t; | |
524 | gmtime_0(&tt, x); | |
525 | ||
526 | /* Copy the values into the array. */ | |
827aef63 | 527 | len = GFC_DESCRIPTOR_EXTENT(tarray,0); |
d2fc5bb1 | 528 | assert (len >= 9); |
827aef63 | 529 | delta = GFC_DESCRIPTOR_STRIDE(tarray,0); |
d2fc5bb1 | 530 | if (delta == 0) |
531 | delta = 1; | |
532 | ||
553877d9 | 533 | vptr = tarray->base_addr; |
d2fc5bb1 | 534 | for (i = 0; i < 9; i++, vptr += delta) |
535 | *vptr = x[i]; | |
536 | } | |
537 | ||
538 | ||
539 | ||
540 | ||
541 | /* LTIME(STIME, TARRAY) - Non-standard | |
542 | ||
543 | Description: Given a system time value STime, fills TArray with values | |
eaae6999 | 544 | extracted from it appropriate to the local time zone using localtime_r(3). |
d2fc5bb1 | 545 | |
546 | The array elements are as follows: | |
547 | ||
548 | 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds | |
549 | 2. Minutes after the hour, range 0-59 | |
550 | 3. Hours past midnight, range 0-23 | |
dc31fb88 | 551 | 4. Day of month, range 1-31 |
d2fc5bb1 | 552 | 5. Number of months since January, range 0-11 |
553 | 6. Years since 1900 | |
554 | 7. Number of days since Sunday, range 0-6 | |
dc31fb88 | 555 | 8. Days since January 1, range 0-365 |
d2fc5bb1 | 556 | 9. Daylight savings indicator: positive if daylight savings is in effect, |
557 | zero if not, and negative if the information isn't available. */ | |
558 | ||
559 | static void | |
560 | ltime_0 (const time_t * t, int x[9]) | |
561 | { | |
562 | struct tm lt; | |
563 | ||
eaae6999 | 564 | localtime_r (t, <); |
d2fc5bb1 | 565 | x[0] = lt.tm_sec; |
566 | x[1] = lt.tm_min; | |
567 | x[2] = lt.tm_hour; | |
568 | x[3] = lt.tm_mday; | |
569 | x[4] = lt.tm_mon; | |
570 | x[5] = lt.tm_year; | |
571 | x[6] = lt.tm_wday; | |
572 | x[7] = lt.tm_yday; | |
573 | x[8] = lt.tm_isdst; | |
574 | } | |
575 | ||
576 | extern void ltime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *); | |
577 | export_proto(ltime_i4); | |
578 | ||
579 | void | |
580 | ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) | |
581 | { | |
582 | int x[9], i; | |
e2b80761 | 583 | index_type len, delta; |
d2fc5bb1 | 584 | GFC_INTEGER_4 *vptr; |
585 | time_t tt; | |
586 | ||
587 | /* Call helper function. */ | |
588 | tt = (time_t) *t; | |
589 | ltime_0(&tt, x); | |
590 | ||
591 | /* Copy the values into the array. */ | |
827aef63 | 592 | len = GFC_DESCRIPTOR_EXTENT(tarray,0); |
d2fc5bb1 | 593 | assert (len >= 9); |
827aef63 | 594 | delta = GFC_DESCRIPTOR_STRIDE(tarray,0); |
d2fc5bb1 | 595 | if (delta == 0) |
596 | delta = 1; | |
597 | ||
553877d9 | 598 | vptr = tarray->base_addr; |
d2fc5bb1 | 599 | for (i = 0; i < 9; i++, vptr += delta) |
600 | *vptr = x[i]; | |
601 | } | |
602 | ||
603 | extern void ltime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *); | |
604 | export_proto(ltime_i8); | |
605 | ||
606 | void | |
607 | ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) | |
608 | { | |
609 | int x[9], i; | |
e2b80761 | 610 | index_type len, delta; |
d2fc5bb1 | 611 | GFC_INTEGER_8 *vptr; |
612 | time_t tt; | |
613 | ||
614 | /* Call helper function. */ | |
615 | tt = (time_t) * t; | |
616 | ltime_0(&tt, x); | |
617 | ||
618 | /* Copy the values into the array. */ | |
827aef63 | 619 | len = GFC_DESCRIPTOR_EXTENT(tarray,0); |
d2fc5bb1 | 620 | assert (len >= 9); |
827aef63 | 621 | delta = GFC_DESCRIPTOR_STRIDE(tarray,0); |
d2fc5bb1 | 622 | if (delta == 0) |
623 | delta = 1; | |
624 | ||
553877d9 | 625 | vptr = tarray->base_addr; |
d2fc5bb1 | 626 | for (i = 0; i < 9; i++, vptr += delta) |
627 | *vptr = x[i]; | |
628 | } | |
629 | ||
630 |