OSDN Git Service

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