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