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