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