libgfortran/intrinsics/date_and_time.c

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