libgfortran/intrinsics/date_and_time.c

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