libgfortran/intrinsics/date_and_time.c

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