libgfortran/intrinsics/date_and_time.c

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