OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [intrinsics/] [date_and_time.c] - Blame information for rev 796

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.