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       assert (len >= VALUES_SIZE);
 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     {
 311       assert (__zone_len >= ZONE_LEN);
 312       fstrcpy (__zone, ZONE_LEN, zone, ZONE_LEN);
 313     }
 314
 315   if (__time)
 316     {
 317       assert (__time_len >= TIME_LEN);
 318       fstrcpy (__time, TIME_LEN, timec, TIME_LEN);
 319     }
 320
 321   if (__date)
 322     {
 323       assert (__date_len >= DATE_LEN);
 324       fstrcpy (__date, DATE_LEN, date, DATE_LEN);
 325     }
 326 }
 327
 328
 329 /* SECNDS (X) - Non-standard
 330
 331    Description: Returns the system time of day, or elapsed time, as a GFC_REAL_4
 332    in seconds.
 333
 334    Class: Non-elemental subroutine.
 335
 336    Arguments:
 337
 338    X must be REAL(4) and the result is of the same type.  The accuracy is system
 339    dependent.
 340
 341    Usage:
 342
 343         T = SECNDS (X)
 344
 345    yields the time in elapsed seconds since X.  If X is 0.0, T is the time in
 346    seconds since midnight. Note that a time that spans midnight but is less than
 347    24hours will be calculated correctly.  */
 348
 349 extern GFC_REAL_4 secnds (GFC_REAL_4 *);
 350 export_proto(secnds);
 351
 352 GFC_REAL_4
 353 secnds (GFC_REAL_4 *x)
 354 {
 355   GFC_INTEGER_4 values[VALUES_SIZE];
 356   GFC_REAL_4 temp1, temp2;
 357
 358   /* Make the INTEGER*4 array for passing to date_and_time.  */
 359   gfc_array_i4 *avalues = internal_malloc_size (sizeof (gfc_array_i4));
 360   avalues->data = &values[0];
 361   GFC_DESCRIPTOR_DTYPE (avalues) = ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT)
 362                                         & GFC_DTYPE_TYPE_MASK) +
 363                                     (4 << GFC_DTYPE_SIZE_SHIFT);
 364
 365   GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1);
 366
 367   date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0);
 368
 369   free (avalues);
 370
 371   temp1 = 3600.0 * (GFC_REAL_4)values[4] +
 372             60.0 * (GFC_REAL_4)values[5] +
 373                    (GFC_REAL_4)values[6] +
 374            0.001 * (GFC_REAL_4)values[7];
 375   temp2 = fmod (*x, 86400.0);
 376   temp2 = (temp1 - temp2 >= 0.0) ? temp2 : (temp2 - 86400.0);
 377   return temp1 - temp2;
 378 }
 379
 380
 381
 382 /* ITIME(X) - Non-standard
 383
 384    Description: Returns the current local time hour, minutes, and seconds
 385    in elements 1, 2, and 3 of X, respectively.  */
 386
 387 static void
 388 itime0 (int x[3])
 389 {
 390 #ifndef HAVE_NO_DATE_TIME
 391   time_t lt;
 392   struct tm local_time;
 393
 394   lt = time (NULL);
 395
 396   if (lt != (time_t) -1)
 397     {
 398       localtime_r (&lt, &local_time);
 399
 400       x[0] = local_time.tm_hour;
 401       x[1] = local_time.tm_min;
 402       x[2] = local_time.tm_sec;
 403     }
 404 #else
 405   x[0] = x[1] = x[2] = -1;
 406 #endif
 407 }
 408
 409 extern void itime_i4 (gfc_array_i4 *);
 410 export_proto(itime_i4);
 411
 412 void
 413 itime_i4 (gfc_array_i4 *__values)
 414 {
 415   int x[3], i;
 416   index_type len, delta;
 417   GFC_INTEGER_4 *vptr;
 418
 419   /* Call helper function.  */
 420   itime0(x);
 421
 422   /* Copy the value into the array.  */
 423   len = GFC_DESCRIPTOR_EXTENT(__values,0);
 424   assert (len >= 3);
 425   delta = GFC_DESCRIPTOR_STRIDE(__values,0);
 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 extern void itime_i8 (gfc_array_i8 *);
 436 export_proto(itime_i8);
 437
 438 void
 439 itime_i8 (gfc_array_i8 *__values)
 440 {
 441   int x[3], i;
 442   index_type len, delta;
 443   GFC_INTEGER_8 *vptr;
 444
 445   /* Call helper function.  */
 446   itime0(x);
 447
 448   /* Copy the value into the array.  */
 449   len = GFC_DESCRIPTOR_EXTENT(__values,0);
 450   assert (len >= 3);
 451   delta = GFC_DESCRIPTOR_STRIDE(__values,0);
 452   if (delta == 0)
 453     delta = 1;
 454
 455   vptr = __values->data;
 456   for (i = 0; i < 3; i++, vptr += delta)
 457     *vptr = x[i];
 458 }
 459
 460
 461
 462 /* IDATE(X) - Non-standard
 463
 464    Description: Fills TArray with the numerical values at the current
 465    local time. The day (in the range 1-31), month (in the range 1-12),
 466    and year appear in elements 1, 2, and 3 of X, respectively.
 467    The year has four significant digits.  */
 468
 469 static void
 470 idate0 (int x[3])
 471 {
 472 #ifndef HAVE_NO_DATE_TIME
 473   time_t lt;
 474   struct tm local_time;
 475
 476   lt = time (NULL);
 477
 478   if (lt != (time_t) -1)
 479     {
 480       localtime_r (&lt, &local_time);
 481
 482       x[0] = local_time.tm_mday;
 483       x[1] = 1 + local_time.tm_mon;
 484       x[2] = 1900 + local_time.tm_year;
 485     }
 486 #else
 487   x[0] = x[1] = x[2] = -1;
 488 #endif
 489 }
 490
 491 extern void idate_i4 (gfc_array_i4 *);
 492 export_proto(idate_i4);
 493
 494 void
 495 idate_i4 (gfc_array_i4 *__values)
 496 {
 497   int x[3], i;
 498   index_type len, delta;
 499   GFC_INTEGER_4 *vptr;
 500
 501   /* Call helper function.  */
 502   idate0(x);
 503
 504   /* Copy the value into the array.  */
 505   len = GFC_DESCRIPTOR_EXTENT(__values,0);
 506   assert (len >= 3);
 507   delta = GFC_DESCRIPTOR_STRIDE(__values,0);
 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 extern void idate_i8 (gfc_array_i8 *);
 518 export_proto(idate_i8);
 519
 520 void
 521 idate_i8 (gfc_array_i8 *__values)
 522 {
 523   int x[3], i;
 524   index_type len, delta;
 525   GFC_INTEGER_8 *vptr;
 526
 527   /* Call helper function.  */
 528   idate0(x);
 529
 530   /* Copy the value into the array.  */
 531   len = GFC_DESCRIPTOR_EXTENT(__values,0);
 532   assert (len >= 3);
 533   delta = GFC_DESCRIPTOR_STRIDE(__values,0);
 534   if (delta == 0)
 535     delta = 1;
 536
 537   vptr = __values->data;
 538   for (i = 0; i < 3; i++, vptr += delta)
 539     *vptr = x[i];
 540 }
 541
 542
 543
 544 /* GMTIME(STIME, TARRAY) - Non-standard
 545
 546    Description: Given a system time value STime, fills TArray with values
 547    extracted from it appropriate to the GMT time zone using gmtime_r(3).
 548
 549    The array elements are as follows:
 550
 551       1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds
 552       2. Minutes after the hour, range 0-59
 553       3. Hours past midnight, range 0-23
 554       4. Day of month, range 0-31
 555       5. Number of months since January, range 0-11
 556       6. Years since 1900
 557       7. Number of days since Sunday, range 0-6
 558       8. Days since January 1
 559       9. Daylight savings indicator: positive if daylight savings is in effect,
 560          zero if not, and negative if the information isn't available.  */
 561
 562 static void
 563 gmtime_0 (const time_t * t, int x[9])
 564 {
 565   struct tm lt;
 566
 567   gmtime_r (t, &lt);
 568   x[0] = lt.tm_sec;
 569   x[1] = lt.tm_min;
 570   x[2] = lt.tm_hour;
 571   x[3] = lt.tm_mday;
 572   x[4] = lt.tm_mon;
 573   x[5] = lt.tm_year;
 574   x[6] = lt.tm_wday;
 575   x[7] = lt.tm_yday;
 576   x[8] = lt.tm_isdst;
 577 }
 578
 579 extern void gmtime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *);
 580 export_proto(gmtime_i4);
 581
 582 void
 583 gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
 584 {
 585   int x[9], i;
 586   index_type len, delta;
 587   GFC_INTEGER_4 *vptr;
 588   time_t tt;
 589
 590   /* Call helper function.  */
 591   tt = (time_t) *t;
 592   gmtime_0(&tt, x);
 593
 594   /* Copy the values into the array.  */
 595   len = GFC_DESCRIPTOR_EXTENT(tarray,0);
 596   assert (len >= 9);
 597   delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
 598   if (delta == 0)
 599     delta = 1;
 600
 601   vptr = tarray->data;
 602   for (i = 0; i < 9; i++, vptr += delta)
 603     *vptr = x[i];
 604 }
 605
 606 extern void gmtime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *);
 607 export_proto(gmtime_i8);
 608
 609 void
 610 gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
 611 {
 612   int x[9], i;
 613   index_type len, delta;
 614   GFC_INTEGER_8 *vptr;
 615   time_t tt;
 616
 617   /* Call helper function.  */
 618   tt = (time_t) *t;
 619   gmtime_0(&tt, x);
 620
 621   /* Copy the values into the array.  */
 622   len = GFC_DESCRIPTOR_EXTENT(tarray,0);
 623   assert (len >= 9);
 624   delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
 625   if (delta == 0)
 626     delta = 1;
 627
 628   vptr = tarray->data;
 629   for (i = 0; i < 9; i++, vptr += delta)
 630     *vptr = x[i];
 631 }
 632
 633
 634
 635
 636 /* LTIME(STIME, TARRAY) - Non-standard
 637
 638    Description: Given a system time value STime, fills TArray with values
 639    extracted from it appropriate to the local time zone using localtime_r(3).
 640
 641    The array elements are as follows:
 642
 643       1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds
 644       2. Minutes after the hour, range 0-59
 645       3. Hours past midnight, range 0-23
 646       4. Day of month, range 0-31
 647       5. Number of months since January, range 0-11
 648       6. Years since 1900
 649       7. Number of days since Sunday, range 0-6
 650       8. Days since January 1
 651       9. Daylight savings indicator: positive if daylight savings is in effect,
 652          zero if not, and negative if the information isn't available.  */
 653
 654 static void
 655 ltime_0 (const time_t * t, int x[9])
 656 {
 657   struct tm lt;
 658
 659   localtime_r (t, &lt);
 660   x[0] = lt.tm_sec;
 661   x[1] = lt.tm_min;
 662   x[2] = lt.tm_hour;
 663   x[3] = lt.tm_mday;
 664   x[4] = lt.tm_mon;
 665   x[5] = lt.tm_year;
 666   x[6] = lt.tm_wday;
 667   x[7] = lt.tm_yday;
 668   x[8] = lt.tm_isdst;
 669 }
 670
 671 extern void ltime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *);
 672 export_proto(ltime_i4);
 673
 674 void
 675 ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
 676 {
 677   int x[9], i;
 678   index_type len, delta;
 679   GFC_INTEGER_4 *vptr;
 680   time_t tt;
 681
 682   /* Call helper function.  */
 683   tt = (time_t) *t;
 684   ltime_0(&tt, x);
 685
 686   /* Copy the values into the array.  */
 687   len = GFC_DESCRIPTOR_EXTENT(tarray,0);
 688   assert (len >= 9);
 689   delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
 690   if (delta == 0)
 691     delta = 1;
 692
 693   vptr = tarray->data;
 694   for (i = 0; i < 9; i++, vptr += delta)
 695     *vptr = x[i];
 696 }
 697
 698 extern void ltime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *);
 699 export_proto(ltime_i8);
 700
 701 void
 702 ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
 703 {
 704   int x[9], i;
 705   index_type len, delta;
 706   GFC_INTEGER_8 *vptr;
 707   time_t tt;
 708
 709   /* Call helper function.  */
 710   tt = (time_t) * t;
 711   ltime_0(&tt, x);
 712
 713   /* Copy the values into the array.  */
 714   len = GFC_DESCRIPTOR_EXTENT(tarray,0);
 715   assert (len >= 9);
 716   delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
 717   if (delta == 0)
 718     delta = 1;
 719
 720   vptr = tarray->data;
 721   for (i = 0; i < 9; i++, vptr += delta)
 722     *vptr = x[i];
 723 }
 724
 725