src/sfm-read.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  18    02111-1307, USA. */
  19
  20 #include <config.h>
  21 #include "sfm.h"
  22 #include "sfmP.h"
  23 #include "error.h"
  24 #include <stdlib.h>
  25 #include <ctype.h>
  26 #include <errno.h>
  27 #include <float.h>
  28 #include "alloc.h"
  29 #include "case.h"
  30 #include "error.h"
  31 #include "file-handle.h"
  32 #include "filename.h"
  33 #include "format.h"
  34 #include "getline.h"
  35 #include "hash.h"
  36 #include "magic.h"
  37 #include "misc.h"
  38 #include "value-labels.h"
  39 #include "str.h"
  40 #include "var.h"
  41
  42 #include "debug-print.h"
  43
  44 /* PORTME: This file may require substantial revision for those
  45    systems that don't meet the typical 32-bit integer/64-bit double
  46    model.  It's kinda hard to tell without having one of them on my
  47    desk.  */
  48
  49 /* sfm's file_handle extension. */
  50 struct sfm_fhuser_ext
  51   {
  52     FILE *file;                 /* Actual file. */
  53     int opened;                 /* Reference count. */
  54
  55     struct dictionary *dict;    /* File's dictionary. */
  56
  57     int reverse_endian;         /* 1=file has endianness opposite us. */
  58     int case_size;              /* Number of `values's per case. */
  59     long ncases;                /* Number of cases, -1 if unknown. */
  60     int compressed;             /* 1=compressed, 0=not compressed. */
  61     double bias;                /* Compression bias, usually 100.0. */
  62     int weight_index;           /* 0-based index of weighting variable, or -1. */
  63
  64     /* File's special constants. */
  65     flt64 sysmis;
  66     flt64 highest;
  67     flt64 lowest;
  68
  69     /* Uncompression buffer. */
  70     flt64 *buf;                 /* Buffer data. */
  71     flt64 *ptr;                 /* Current location in buffer. */
  72     flt64 *end;                 /* End of buffer data. */
  73
  74     /* Compression instruction octet. */
  75     unsigned char x[sizeof (flt64)];
  76     /* Current instruction octet. */
  77     unsigned char *y;           /* Location in current instruction octet. */
  78   };
  79
  80 static struct fh_ext_class sfm_r_class;
  81 \f
  82 /* Utilities. */
  83
  84 /* bswap_int32(): Reverse the byte order of 32-bit integer *X. */
  85 static inline void
  86 bswap_int32 (int32 *x)
  87 {
  88   unsigned char *y = (unsigned char *) x;
  89   unsigned char t;
  90
  91   t = y[0];
  92   y[0] = y[3];
  93   y[3] = t;
  94
  95   t = y[1];
  96   y[1] = y[2];
  97   y[2] = t;
  98 }
  99
 100 /* Reverse the byte order of 64-bit floating point *X. */
 101 static inline void
 102 bswap_flt64 (flt64 *x)
 103 {
 104   unsigned char *y = (unsigned char *) x;
 105   unsigned char t;
 106
 107   t = y[0];
 108   y[0] = y[7];
 109   y[7] = t;
 110
 111   t = y[1];
 112   y[1] = y[6];
 113   y[6] = t;
 114
 115   t = y[2];
 116   y[2] = y[5];
 117   y[5] = t;
 118
 119   t = y[3];
 120   y[3] = y[4];
 121   y[4] = t;
 122 }
 123
 124 static void
 125 corrupt_msg (int class, const char *format,...)
 126      PRINTF_FORMAT (2, 3);
 127
 128 /* Displays a corrupt sysfile error. */
 129 static void
 130 corrupt_msg (int class, const char *format,...)
 131 {
 132   char buf[1024];
 133
 134   {
 135     va_list args;
 136
 137     va_start (args, format);
 138     vsnprintf (buf, 1024, format, args);
 139     va_end (args);
 140   }
 141
 142   {
 143     struct error e;
 144
 145     e.class = class;
 146     getl_location (&e.where.filename, &e.where.line_number);
 147     e.title = _("corrupt system file: ");
 148     e.text = buf;
 149
 150     err_vmsg (&e);
 151   }
 152 }
 153
 154 /* Closes a system file after we're done with it. */
 155 static void
 156 sfm_close (struct file_handle *h)
 157 {
 158   struct sfm_fhuser_ext *ext = h->ext;
 159
 160   ext->opened--;
 161   assert (ext->opened == 0);
 162   if (EOF == fn_close (handle_get_filename (h), ext->file))
 163     msg (ME, _("%s: Closing system file: %s."),
 164          handle_get_filename (h), strerror (errno));
 165   free (ext->buf);
 166   free (h->ext);
 167 }
 168
 169 /* Closes a system file if we're done with it. */
 170 void
 171 sfm_maybe_close (struct file_handle *h)
 172 {
 173   struct sfm_fhuser_ext *ext = h->ext;
 174
 175   if (ext->opened == 1)
 176     fh_close_handle (h);
 177   else
 178     ext->opened--;
 179 }
 180 \f
 181 /* Dictionary reader. */
 182
 183 static void *bufread (struct file_handle * handle, void *buf, size_t nbytes,
 184                       size_t minalloc);
 185
 186 static int read_header (struct file_handle * h, struct sfm_read_info * inf);
 187 static int parse_format_spec (struct file_handle * h, int32 s,
 188                               struct fmt_spec * v, struct variable *vv);
 189 static int read_value_labels (struct file_handle * h, struct variable ** var_by_index);
 190 static int read_variables (struct file_handle * h, struct variable *** var_by_index);
 191 static int read_machine_int32_info (struct file_handle * h, int size, int count);
 192 static int read_machine_flt64_info (struct file_handle * h, int size, int count);
 193 static int read_documents (struct file_handle * h);
 194
 195 /* Displays the message X with corrupt_msg, then jumps to the lossage
 196    label. */
 197 #define lose(X)                                 \
 198         do                                      \
 199           {                                     \
 200             corrupt_msg X;                      \
 201             goto lossage;                       \
 202           }                                     \
 203         while (0)
 204
 205 /* Calls bufread with the specified arguments, and jumps to lossage if
 206    the read fails. */
 207 #define assertive_bufread(a,b,c,d)              \
 208         do                                      \
 209           {                                     \
 210             if (!bufread (a,b,c,d))             \
 211               goto lossage;                     \
 212           }                                     \
 213         while (0)
 214
 215 /* Reads the dictionary from file with handle H, and returns it in a
 216    dictionary structure.  This dictionary may be modified in order to
 217    rename, reorder, and delete variables, etc.  */
 218 struct dictionary *
 219 sfm_read_dictionary (struct file_handle * h, struct sfm_read_info * inf)
 220 {
 221   /* The file handle extension record. */
 222   struct sfm_fhuser_ext *ext;
 223
 224   /* Allows for quick reference to variables according to indexes
 225      relative to position within a case. */
 226   struct variable **var_by_index = NULL;
 227
 228   /* Check whether the file is already open. */
 229   if (h->class == &sfm_r_class)
 230     {
 231       ext = h->ext;
 232       ext->opened++;
 233       return ext->dict;
 234     }
 235   else if (h->class != NULL)
 236     {
 237       msg (ME, _("Cannot read file %s as system file: already opened for %s."),
 238            handle_get_name (h), h->class->name);
 239       return NULL;
 240     }
 241
 242   msg (VM (1), _("%s: Opening system-file handle %s for reading."),
 243        handle_get_filename (h), handle_get_name (h));
 244
 245   /* Open the physical disk file. */
 246   ext = xmalloc (sizeof (struct sfm_fhuser_ext));
 247   ext->file = fn_open (handle_get_filename (h), "rb");
 248   if (ext->file == NULL)
 249     {
 250       msg (ME, _("An error occurred while opening \"%s\" for reading "
 251                  "as a system file: %s."),
 252            handle_get_filename (h), strerror (errno));
 253       err_cond_fail ();
 254       free (ext);
 255       return NULL;
 256     }
 257
 258   /* Initialize the sfm_fhuser_ext structure. */
 259   h->class = &sfm_r_class;
 260   h->ext = ext;
 261   ext->dict = NULL;
 262   ext->buf = ext->ptr = ext->end = NULL;
 263   ext->y = ext->x + sizeof ext->x;
 264   ext->opened = 1;
 265
 266   /* Default special constants. */
 267   ext->sysmis = -FLT64_MAX;
 268   ext->highest = FLT64_MAX;
 269   ext->lowest = second_lowest_flt64;
 270
 271   /* Read the header. */
 272   if (!read_header (h, inf))
 273     goto lossage;
 274
 275   /* Read about the variables. */
 276   if (!read_variables (h, &var_by_index))
 277     goto lossage;
 278
 279   /* Handle weighting. */
 280   if (ext->weight_index != -1)
 281     {
 282       struct variable *wv = var_by_index[ext->weight_index];
 283
 284       if (wv == NULL)
 285         lose ((ME, _("%s: Weighting variable may not be a continuation of "
 286                "a long string variable."), handle_get_filename (h)));
 287       else if (wv->type == ALPHA)
 288         lose ((ME, _("%s: Weighting variable may not be a string variable."),
 289                handle_get_filename (h)));
 290
 291       dict_set_weight (ext->dict, wv);
 292     }
 293   else
 294     dict_set_weight (ext->dict, NULL);
 295
 296   /* Read records of types 3, 4, 6, and 7. */
 297   for (;;)
 298     {
 299       int32 rec_type;
 300
 301       assertive_bufread (h, &rec_type, sizeof rec_type, 0);
 302       if (ext->reverse_endian)
 303         bswap_int32 (&rec_type);
 304
 305       switch (rec_type)
 306         {
 307         case 3:
 308           if (!read_value_labels (h, var_by_index))
 309             goto lossage;
 310           break;
 311
 312         case 4:
 313           lose ((ME, _("%s: Orphaned variable index record (type 4).  Type 4 "
 314                        "records must always immediately follow type 3 "
 315                        "records."),
 316                  handle_get_filename (h)));
 317
 318         case 6:
 319           if (!read_documents (h))
 320             goto lossage;
 321           break;
 322
 323         case 7:
 324           {
 325             struct
 326               {
 327                 int32 subtype P;
 328                 int32 size P;
 329                 int32 count P;
 330               }
 331             data;
 332
 333             int skip = 0;
 334
 335             assertive_bufread (h, &data, sizeof data, 0);
 336             if (ext->reverse_endian)
 337               {
 338                 bswap_int32 (&data.subtype);
 339                 bswap_int32 (&data.size);
 340                 bswap_int32 (&data.count);
 341               }
 342
 343             switch (data.subtype)
 344               {
 345               case 3:
 346                 if (!read_machine_int32_info (h, data.size, data.count))
 347                   goto lossage;
 348                 break;
 349
 350               case 4:
 351                 if (!read_machine_flt64_info (h, data.size, data.count))
 352                   goto lossage;
 353                 break;
 354
 355               case 5:
 356               case 6:
 357               case 11: /* ?? Used by SPSS 8.0. */
 358                 skip = 1;
 359                 break;
 360
 361               default:
 362                 msg (MW, _("%s: Unrecognized record type 7, subtype %d "
 363                            "encountered in system file."),
 364                      handle_get_filename (h), data.subtype);
 365                 skip = 1;
 366               }
 367
 368             if (skip)
 369               {
 370                 void *x = bufread (h, NULL, data.size * data.count, 0);
 371                 if (x == NULL)
 372                   goto lossage;
 373                 free (x);
 374               }
 375           }
 376           break;
 377
 378         case 999:
 379           {
 380             int32 filler;
 381
 382             assertive_bufread (h, &filler, sizeof filler, 0);
 383             goto break_out_of_loop;
 384           }
 385
 386         default:
 387           lose ((ME, _("%s: Unrecognized record type %d."),
 388                  handle_get_filename (h), rec_type));
 389         }
 390     }
 391
 392 break_out_of_loop:
 393   /* Come here on successful completion. */
 394   msg (VM (2), _("Read system-file dictionary successfully."));
 395
 396   free (var_by_index);
 397   return ext->dict;
 398
 399 lossage:
 400   /* Come here on unsuccessful completion. */
 401   msg (VM (1), _("Error reading system-file header."));
 402
 403   free (var_by_index);
 404   fn_close (handle_get_filename (h), ext->file);
 405   if (ext && ext->dict)
 406     dict_destroy (ext->dict);
 407   free (ext);
 408   h->class = NULL;
 409   h->ext = NULL;
 410   return NULL;
 411 }
 412
 413 /* Read record type 7, subtype 3. */
 414 static int
 415 read_machine_int32_info (struct file_handle * h, int size, int count)
 416 {
 417   struct sfm_fhuser_ext *ext = h->ext;
 418
 419   int32 data[8];
 420   int file_bigendian;
 421
 422   int i;
 423
 424   if (size != sizeof (int32) || count != 8)
 425     lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
 426                  "subtype 3.    Expected size %d, count 8."),
 427            handle_get_filename (h), size, count, sizeof (int32)));
 428
 429   assertive_bufread (h, data, sizeof data, 0);
 430   if (ext->reverse_endian)
 431     for (i = 0; i < 8; i++)
 432       bswap_int32 (&data[i]);
 433
 434   /* PORTME: Check floating-point representation. */
 435 #ifdef FPREP_IEEE754
 436   if (data[4] != 1)
 437     lose ((ME, _("%s: Floating-point representation in system file is not "
 438                  "IEEE-754.  PSPP cannot convert between floating-point "
 439                  "formats."),
 440            handle_get_filename (h)));
 441 #endif
 442
 443   /* PORTME: Check recorded file endianness against intuited file
 444      endianness. */
 445 #ifdef WORDS_BIGENDIAN
 446   file_bigendian = 1;
 447 #else
 448   file_bigendian = 0;
 449 #endif
 450   if (ext->reverse_endian)
 451     file_bigendian ^= 1;
 452   if (file_bigendian ^ (data[6] == 1))
 453     lose ((ME, _("%s: File-indicated endianness (%s) does not match endianness "
 454                  "intuited from file header (%s)."),
 455            handle_get_filename (h),
 456            file_bigendian ? _("big-endian") : _("little-endian"),
 457            data[6] == 1 ? _("big-endian") : (data[6] == 2 ? _("little-endian")
 458                                           : _("unknown"))));
 459
 460   /* PORTME: Character representation code. */
 461   if (data[7] != 2 && data[7] != 3)
 462     lose ((ME, _("%s: File-indicated character representation code (%s) is not "
 463                  "ASCII."),
 464            handle_get_filename (h),
 465            (data[7] == 1 ? "EBCDIC"
 466             : (data[7] == 4 ? _("DEC Kanji") : _("Unknown")))));
 467
 468   return 1;
 469
 470 lossage:
 471   return 0;
 472 }
 473
 474 /* Read record type 7, subtype 4. */
 475 static int
 476 read_machine_flt64_info (struct file_handle * h, int size, int count)
 477 {
 478   struct sfm_fhuser_ext *ext = h->ext;
 479
 480   flt64 data[3];
 481
 482   int i;
 483
 484   if (size != sizeof (flt64) || count != 3)
 485     lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
 486                  "subtype 4.    Expected size %d, count 8."),
 487            handle_get_filename (h), size, count, sizeof (flt64)));
 488
 489   assertive_bufread (h, data, sizeof data, 0);
 490   if (ext->reverse_endian)
 491     for (i = 0; i < 3; i++)
 492       bswap_flt64 (&data[i]);
 493
 494   if (data[0] != SYSMIS || data[1] != FLT64_MAX
 495       || data[2] != second_lowest_flt64)
 496     {
 497       ext->sysmis = data[0];
 498       ext->highest = data[1];
 499       ext->lowest = data[2];
 500       msg (MW, _("%s: File-indicated value is different from internal value "
 501                  "for at least one of the three system values.  SYSMIS: "
 502                  "indicated %g, expected %g; HIGHEST: %g, %g; LOWEST: "
 503                  "%g, %g."),
 504            handle_get_filename (h), (double) data[0], (double) SYSMIS,
 505            (double) data[1], (double) FLT64_MAX,
 506            (double) data[2], (double) second_lowest_flt64);
 507     }
 508
 509   return 1;
 510
 511 lossage:
 512   return 0;
 513 }
 514
 515 static int
 516 read_header (struct file_handle * h, struct sfm_read_info * inf)
 517 {
 518   struct sfm_fhuser_ext *ext = h->ext;  /* File extension strcut. */
 519   struct sysfile_header hdr;            /* Disk buffer. */
 520   struct dictionary *dict;              /* File dictionary. */
 521   char prod_name[sizeof hdr.prod_name + 1];     /* Buffer for product name. */
 522   int skip_amt = 0;                     /* Amount of product name to omit. */
 523   int i;
 524
 525   /* Create the dictionary. */
 526   dict = ext->dict = dict_create ();
 527
 528   /* Read header, check magic. */
 529   assertive_bufread (h, &hdr, sizeof hdr, 0);
 530   if (0 != strncmp ("$FL2", hdr.rec_type, 4))
 531     lose ((ME, _("%s: Bad magic.  Proper system files begin with "
 532                  "the four characters `$FL2'. This file will not be read."),
 533            handle_get_filename (h)));
 534
 535   /* Check eye-catcher string. */
 536   memcpy (prod_name, hdr.prod_name, sizeof hdr.prod_name);
 537   for (i = 0; i < 60; i++)
 538     if (!isprint ((unsigned char) prod_name[i]))
 539       prod_name[i] = ' ';
 540   for (i = 59; i >= 0; i--)
 541     if (!isgraph ((unsigned char) prod_name[i]))
 542       {
 543         prod_name[i] = '\0';
 544         break;
 545       }
 546   prod_name[60] = '\0';
 547
 548   {
 549 #define N_PREFIXES 2
 550     static const char *prefix[N_PREFIXES] =
 551       {
 552         "@(#) SPSS DATA FILE",
 553         "SPSS SYSTEM FILE.",
 554       };
 555
 556     int i;
 557
 558     for (i = 0; i < N_PREFIXES; i++)
 559       if (!strncmp (prefix[i], hdr.prod_name, strlen (prefix[i])))
 560         {
 561           skip_amt = strlen (prefix[i]);
 562           break;
 563         }
 564   }
 565
 566   /* Check endianness. */
 567   /* PORTME: endianness. */
 568   if (hdr.layout_code == 2)
 569     ext->reverse_endian = 0;
 570   else
 571     {
 572       bswap_int32 (&hdr.layout_code);
 573       if (hdr.layout_code != 2)
 574         lose ((ME, _("%s: File layout code has unexpected value %d.  Value "
 575                      "should be 2, in big-endian or little-endian format."),
 576                handle_get_filename (h), hdr.layout_code));
 577
 578       ext->reverse_endian = 1;
 579       bswap_int32 (&hdr.case_size);
 580       bswap_int32 (&hdr.compressed);
 581       bswap_int32 (&hdr.weight_index);
 582       bswap_int32 (&hdr.ncases);
 583       bswap_flt64 (&hdr.bias);
 584     }
 585
 586   /* Copy basic info and verify correctness. */
 587   ext->case_size = hdr.case_size;
 588   if (hdr.case_size <= 0 || ext->case_size > (INT_MAX
 589                                               / (int) sizeof (union value) / 2))
 590     lose ((ME, _("%s: Number of elements per case (%d) is not between 1 "
 591                  "and %d."),
 592            handle_get_filename (h), hdr.case_size,
 593            INT_MAX / sizeof (union value) / 2));
 594
 595   ext->compressed = hdr.compressed;
 596
 597   ext->weight_index = hdr.weight_index - 1;
 598   if (hdr.weight_index < 0 || hdr.weight_index > hdr.case_size)
 599     lose ((ME, _("%s: Index of weighting variable (%d) is not between 0 "
 600                  "and number of elements per case (%d)."),
 601            handle_get_filename (h), hdr.weight_index, ext->case_size));
 602
 603   ext->ncases = hdr.ncases;
 604   if (ext->ncases < -1 || ext->ncases > INT_MAX / 2)
 605     lose ((ME, _("%s: Number of cases in file (%ld) is not between -1 and "
 606            "%d."), handle_get_filename (h), (long) ext->ncases, INT_MAX / 2));
 607
 608   ext->bias = hdr.bias;
 609   if (ext->bias != 100.0)
 610     corrupt_msg (MW, _("%s: Compression bias (%g) is not the usual "
 611                        "value of 100."),
 612                  handle_get_filename (h), ext->bias);
 613
 614   /* Make a file label only on the condition that the given label is
 615      not all spaces or nulls. */
 616   {
 617     int i;
 618
 619     for (i = sizeof hdr.file_label - 1; i >= 0; i--)
 620       if (!isspace ((unsigned char) hdr.file_label[i])
 621           && hdr.file_label[i] != 0)
 622         {
 623           char *label = xmalloc (i + 2);
 624           memcpy (label, hdr.file_label, i + 1);
 625           label[i + 1] = 0;
 626           dict_set_label (dict, label);
 627           free (label);
 628           break;
 629         }
 630   }
 631
 632   if (inf)
 633     {
 634       char *cp;
 635
 636       memcpy (inf->creation_date, hdr.creation_date, 9);
 637       inf->creation_date[9] = 0;
 638
 639       memcpy (inf->creation_time, hdr.creation_time, 8);
 640       inf->creation_time[8] = 0;
 641
 642 #ifdef WORDS_BIGENDIAN
 643       inf->bigendian = !ext->reverse_endian;
 644 #else
 645       inf->bigendian = ext->reverse_endian;
 646 #endif
 647
 648       inf->compressed = hdr.compressed;
 649
 650       inf->ncases = hdr.ncases;
 651
 652       for (cp = &prod_name[skip_amt]; cp < &prod_name[60]; cp++)
 653         if (isgraph ((unsigned char) *cp))
 654           break;
 655       strcpy (inf->product, cp);
 656     }
 657
 658   return 1;
 659
 660 lossage:
 661   return 0;
 662 }
 663
 664 /* Reads most of the dictionary from file H; also fills in the
 665    associated VAR_BY_INDEX array.  The get.* elements in the
 666    created dictionary are set to appropriate values to allow the
 667    file to be read.  */
 668 static int
 669 read_variables (struct file_handle * h, struct variable *** var_by_index)
 670 {
 671   int i;
 672
 673   struct sfm_fhuser_ext *ext = h->ext;  /* File extension record. */
 674   struct dictionary *dict = ext->dict;  /* Dictionary being constructed. */
 675   struct sysfile_variable sv;           /* Disk buffer. */
 676   int long_string_count = 0;    /* # of long string continuation
 677                                    records still expected. */
 678   int next_value = 0;           /* Index to next `value' structure. */
 679
 680   /* Allocate variables. */
 681   *var_by_index = xmalloc (sizeof **var_by_index * ext->case_size);
 682
 683   /* Read in the entry for each variable and use the info to
 684      initialize the dictionary. */
 685   for (i = 0; i < ext->case_size; i++)
 686     {
 687       struct variable *vv;
 688       char name[9];
 689       int j;
 690
 691       assertive_bufread (h, &sv, sizeof sv, 0);
 692
 693       if (ext->reverse_endian)
 694         {
 695           bswap_int32 (&sv.rec_type);
 696           bswap_int32 (&sv.type);
 697           bswap_int32 (&sv.has_var_label);
 698           bswap_int32 (&sv.n_missing_values);
 699           bswap_int32 (&sv.print);
 700           bswap_int32 (&sv.write);
 701         }
 702
 703       if (sv.rec_type != 2)
 704         lose ((ME, _("%s: position %d: Bad record type (%d); "
 705                      "the expected value was 2."),
 706                handle_get_filename (h), i, sv.rec_type));
 707
 708       /* If there was a long string previously, make sure that the
 709          continuations are present; otherwise make sure there aren't
 710          any. */
 711       if (long_string_count)
 712         {
 713           if (sv.type != -1)
 714             lose ((ME, _("%s: position %d: String variable does not have "
 715                          "proper number of continuation records."),
 716                    handle_get_filename (h), i));
 717
 718           (*var_by_index)[i] = NULL;
 719           long_string_count--;
 720           continue;
 721         }
 722       else if (sv.type == -1)
 723         lose ((ME, _("%s: position %d: Superfluous long string continuation "
 724                      "record."),
 725                handle_get_filename (h), i));
 726
 727       /* Check fields for validity. */
 728       if (sv.type < 0 || sv.type > 255)
 729         lose ((ME, _("%s: position %d: Bad variable type code %d."),
 730                handle_get_filename (h), i, sv.type));
 731       if (sv.has_var_label != 0 && sv.has_var_label != 1)
 732         lose ((ME, _("%s: position %d: Variable label indicator field is not "
 733                "0 or 1."), handle_get_filename (h), i));
 734       if (sv.n_missing_values < -3 || sv.n_missing_values > 3
 735           || sv.n_missing_values == -1)
 736         lose ((ME, _("%s: position %d: Missing value indicator field is not "
 737                      "-3, -2, 0, 1, 2, or 3."), handle_get_filename (h), i));
 738
 739       /* Copy first character of variable name. */
 740       if (!isalpha ((unsigned char) sv.name[0])
 741           && sv.name[0] != '@' && sv.name[0] != '#')
 742         lose ((ME, _("%s: position %d: Variable name begins with invalid "
 743                      "character."),
 744                handle_get_filename (h), i));
 745       if (islower ((unsigned char) sv.name[0]))
 746         msg (MW, _("%s: position %d: Variable name begins with lowercase letter "
 747                    "%c."),
 748              handle_get_filename (h), i, sv.name[0]);
 749       if (sv.name[0] == '#')
 750         msg (MW, _("%s: position %d: Variable name begins with octothorpe "
 751                    "(`#').  Scratch variables should not appear in system "
 752                    "files."),
 753              handle_get_filename (h), i);
 754       name[0] = toupper ((unsigned char) (sv.name[0]));
 755
 756       /* Copy remaining characters of variable name. */
 757       for (j = 1; j < 8; j++)
 758         {
 759           int c = (unsigned char) sv.name[j];
 760
 761           if (isspace (c))
 762             break;
 763           else if (islower (c))
 764             {
 765               msg (MW, _("%s: position %d: Variable name character %d is "
 766                          "lowercase letter %c."),
 767                    handle_get_filename (h), i, j + 1, sv.name[j]);
 768               name[j] = toupper ((unsigned char) (c));
 769             }
 770           else if (isalnum (c) || c == '.' || c == '@'
 771                    || c == '#' || c == '$' || c == '_')
 772             name[j] = c;
 773           else
 774             lose ((ME, _("%s: position %d: character `\\%03o' (%c) is not valid in a "
 775                          "variable name."),
 776                    handle_get_filename (h), i, c, c));
 777         }
 778       name[j] = 0;
 779
 780       /* Create variable. */
 781       vv = (*var_by_index)[i] = dict_create_var (dict, name, sv.type);
 782       if (vv == NULL)
 783         lose ((ME, _("%s: Duplicate variable name `%s' within system file."),
 784                handle_get_filename (h), name));
 785
 786       /* Case reading data. */
 787       vv->get.fv = next_value;
 788       if (sv.type == 0)
 789         vv->get.nv = 1;
 790       else
 791         vv->get.nv = DIV_RND_UP (sv.type, sizeof (flt64));
 792       long_string_count = vv->get.nv - 1;
 793       next_value += vv->get.nv;
 794
 795       /* Get variable label, if any. */
 796       if (sv.has_var_label == 1)
 797         {
 798           /* Disk buffer. */
 799           int32 len;
 800
 801           /* Read length of label. */
 802           assertive_bufread (h, &len, sizeof len, 0);
 803           if (ext->reverse_endian)
 804             bswap_int32 (&len);
 805
 806           /* Check len. */
 807           if (len < 0 || len > 255)
 808             lose ((ME, _("%s: Variable %s indicates variable label of invalid "
 809                          "length %d."),
 810                    handle_get_filename (h), vv->name, len));
 811
 812           /* Read label into variable structure. */
 813           vv->label = bufread (h, NULL, ROUND_UP (len, sizeof (int32)), len + 1);
 814           if (vv->label == NULL)
 815             goto lossage;
 816           vv->label[len] = '\0';
 817         }
 818
 819       /* Set missing values. */
 820       if (sv.n_missing_values != 0)
 821         {
 822           flt64 mv[3];
 823
 824           if (vv->width > MAX_SHORT_STRING)
 825             lose ((ME, _("%s: Long string variable %s may not have missing "
 826                          "values."),
 827                    handle_get_filename (h), vv->name));
 828
 829           assertive_bufread (h, mv, sizeof *mv * abs (sv.n_missing_values), 0);
 830
 831           if (ext->reverse_endian && vv->type == NUMERIC)
 832             for (j = 0; j < abs (sv.n_missing_values); j++)
 833               bswap_flt64 (&mv[j]);
 834
 835           if (sv.n_missing_values > 0)
 836             {
 837               vv->miss_type = sv.n_missing_values;
 838               if (vv->type == NUMERIC)
 839                 for (j = 0; j < sv.n_missing_values; j++)
 840                   vv->missing[j].f = mv[j];
 841               else
 842                 for (j = 0; j < sv.n_missing_values; j++)
 843                   memcpy (vv->missing[j].s, &mv[j], vv->width);
 844             }
 845           else
 846             {
 847               int x = 0;
 848
 849               if (vv->type == ALPHA)
 850                 lose ((ME, _("%s: String variable %s may not have missing "
 851                              "values specified as a range."),
 852                        handle_get_filename (h), vv->name));
 853
 854               if (mv[0] == ext->lowest)
 855                 {
 856                   vv->miss_type = MISSING_LOW;
 857                   vv->missing[x++].f = mv[1];
 858                 }
 859               else if (mv[1] == ext->highest)
 860                 {
 861                   vv->miss_type = MISSING_HIGH;
 862                   vv->missing[x++].f = mv[0];
 863                 }
 864               else
 865                 {
 866                   vv->miss_type = MISSING_RANGE;
 867                   vv->missing[x++].f = mv[0];
 868                   vv->missing[x++].f = mv[1];
 869                 }
 870
 871               if (sv.n_missing_values == -3)
 872                 {
 873                   vv->miss_type += 3;
 874                   vv->missing[x++].f = mv[2];
 875                 }
 876             }
 877         }
 878       else
 879         vv->miss_type = MISSING_NONE;
 880
 881       if (!parse_format_spec (h, sv.print, &vv->print, vv)
 882           || !parse_format_spec (h, sv.write, &vv->write, vv))
 883         goto lossage;
 884     }
 885
 886   /* Some consistency checks. */
 887   if (long_string_count != 0)
 888     lose ((ME, _("%s: Long string continuation records omitted at end of "
 889                  "dictionary."),
 890            handle_get_filename (h)));
 891   if (next_value != ext->case_size)
 892     lose ((ME, _("%s: System file header indicates %d variable positions but "
 893                  "%d were read from file."),
 894            handle_get_filename (h), ext->case_size, next_value));
 895
 896   return 1;
 897
 898 lossage:
 899   dict_destroy (dict);
 900   ext->dict = NULL;
 901
 902   return 0;
 903 }
 904
 905 /* Translates the format spec from sysfile format to internal
 906    format. */
 907 static int
 908 parse_format_spec (struct file_handle *h, int32 s, struct fmt_spec *v, struct variable *vv)
 909 {
 910   v->type = translate_fmt ((s >> 16) & 0xff);
 911   if (v->type == -1)
 912     lose ((ME, _("%s: Bad format specifier byte (%d)."),
 913            handle_get_filename (h), (s >> 16) & 0xff));
 914   v->w = (s >> 8) & 0xff;
 915   v->d = s & 0xff;
 916
 917   /* FIXME?  Should verify the resulting specifier more thoroughly. */
 918
 919   if (v->type == -1)
 920     lose ((ME, _("%s: Bad format specifier byte (%d)."),
 921            handle_get_filename (h), (s >> 16) & 0xff));
 922   if ((vv->type == ALPHA) ^ ((formats[v->type].cat & FCAT_STRING) != 0))
 923     lose ((ME, _("%s: %s variable %s has %s format specifier %s."),
 924            handle_get_filename (h),
 925            vv->type == ALPHA ? _("String") : _("Numeric"),
 926            vv->name,
 927            formats[v->type].cat & FCAT_STRING ? _("string") : _("numeric"),
 928            formats[v->type].name));
 929   return 1;
 930
 931 lossage:
 932   return 0;
 933 }
 934
 935 /* Reads value labels from sysfile H and inserts them into the
 936    associated dictionary. */
 937 int
 938 read_value_labels (struct file_handle * h, struct variable ** var_by_index)
 939 {
 940   struct sfm_fhuser_ext *ext = h->ext;  /* File extension record. */
 941
 942   struct label
 943     {
 944       unsigned char raw_value[8]; /* Value as uninterpreted bytes. */
 945       union value value;        /* Value. */
 946       char *label;              /* Null-terminated label string. */
 947     };
 948
 949   struct label *labels = NULL;
 950   int32 n_labels;               /* Number of labels. */
 951
 952   struct variable **var = NULL; /* Associated variables. */
 953   int32 n_vars;                 /* Number of associated variables. */
 954
 955   int i;
 956
 957   /* First step: read the contents of the type 3 record and record its
 958      contents.  Note that we can't do much with the data since we
 959      don't know yet whether it is of numeric or string type. */
 960
 961   /* Read number of labels. */
 962   assertive_bufread (h, &n_labels, sizeof n_labels, 0);
 963   if (ext->reverse_endian)
 964     bswap_int32 (&n_labels);
 965
 966   /* Allocate memory. */
 967   labels = xmalloc (n_labels * sizeof *labels);
 968   for (i = 0; i < n_labels; i++)
 969     labels[i].label = NULL;
 970
 971   /* Read each value/label tuple into labels[]. */
 972   for (i = 0; i < n_labels; i++)
 973     {
 974       struct label *label = labels + i;
 975       unsigned char label_len;
 976       size_t padded_len;
 977
 978       /* Read value. */
 979       assertive_bufread (h, label->raw_value, sizeof label->raw_value, 0);
 980
 981       /* Read label length. */
 982       assertive_bufread (h, &label_len, sizeof label_len, 0);
 983       padded_len = ROUND_UP (label_len + 1, sizeof (flt64));
 984
 985       /* Read label, padding. */
 986       label->label = xmalloc (padded_len + 1);
 987       assertive_bufread (h, label->label, padded_len - 1, 0);
 988       label->label[label_len] = 0;
 989     }
 990
 991   /* Second step: Read the type 4 record that has the list of
 992      variables to which the value labels are to be applied. */
 993
 994   /* Read record type of type 4 record. */
 995   {
 996     int32 rec_type;
 997
 998     assertive_bufread (h, &rec_type, sizeof rec_type, 0);
 999     if (ext->reverse_endian)
1000       bswap_int32 (&rec_type);
1001
1002     if (rec_type != 4)
1003       lose ((ME, _("%s: Variable index record (type 4) does not immediately "
1004                    "follow value label record (type 3) as it should."),
1005              handle_get_filename (h)));
1006   }
1007
1008   /* Read number of variables associated with value label from type 4
1009      record. */
1010   assertive_bufread (h, &n_vars, sizeof n_vars, 0);
1011   if (ext->reverse_endian)
1012     bswap_int32 (&n_vars);
1013   if (n_vars < 1 || n_vars > dict_get_var_cnt (ext->dict))
1014     lose ((ME, _("%s: Number of variables associated with a value label (%d) "
1015                  "is not between 1 and the number of variables (%d)."),
1016            handle_get_filename (h), n_vars, dict_get_var_cnt (ext->dict)));
1017
1018   /* Read the list of variables. */
1019   var = xmalloc (n_vars * sizeof *var);
1020   for (i = 0; i < n_vars; i++)
1021     {
1022       int32 var_index;
1023       struct variable *v;
1024
1025       /* Read variable index, check range. */
1026       assertive_bufread (h, &var_index, sizeof var_index, 0);
1027       if (ext->reverse_endian)
1028         bswap_int32 (&var_index);
1029       if (var_index < 1 || var_index > ext->case_size)
1030         lose ((ME, _("%s: Variable index associated with value label (%d) is "
1031                      "not between 1 and the number of values (%d)."),
1032                handle_get_filename (h), var_index, ext->case_size));
1033
1034       /* Make sure it's a real variable. */
1035       v = var_by_index[var_index - 1];
1036       if (v == NULL)
1037         lose ((ME, _("%s: Variable index associated with value label (%d) "
1038                      "refers to a continuation of a string variable, not to "
1039                      "an actual variable."),
1040                handle_get_filename (h), var_index));
1041       if (v->type == ALPHA && v->width > MAX_SHORT_STRING)
1042         lose ((ME, _("%s: Value labels are not allowed on long string "
1043                      "variables (%s)."),
1044                handle_get_filename (h), v->name));
1045
1046       /* Add it to the list of variables. */
1047       var[i] = v;
1048     }
1049
1050   /* Type check the variables. */
1051   for (i = 1; i < n_vars; i++)
1052     if (var[i]->type != var[0]->type)
1053       lose ((ME, _("%s: Variables associated with value label are not all of "
1054                    "identical type.  Variable %s has %s type, but variable "
1055                    "%s has %s type."),
1056              handle_get_filename (h),
1057              var[0]->name, var[0]->type == ALPHA ? _("string") : _("numeric"),
1058              var[i]->name, var[i]->type == ALPHA ? _("string") : _("numeric")));
1059
1060   /* Fill in labels[].value, now that we know the desired type. */
1061   for (i = 0; i < n_labels; i++)
1062     {
1063       struct label *label = labels + i;
1064
1065       if (var[0]->type == ALPHA)
1066         {
1067           const int copy_len = min (sizeof (label->raw_value),
1068                                     sizeof (label->label));
1069           memcpy (label->value.s, label->raw_value, copy_len);
1070         } else {
1071           flt64 f;
1072           assert (sizeof f == sizeof label->raw_value);
1073           memcpy (&f, label->raw_value, sizeof f);
1074           if (ext->reverse_endian)
1075             bswap_flt64 (&f);
1076           label->value.f = f;
1077         }
1078     }
1079
1080   /* Assign the value_label's to each variable. */
1081   for (i = 0; i < n_vars; i++)
1082     {
1083       struct variable *v = var[i];
1084       int j;
1085
1086       /* Add each label to the variable. */
1087       for (j = 0; j < n_labels; j++)
1088         {
1089           struct label *label = labels + j;
1090           if (!val_labs_replace (v->val_labs, label->value, label->label))
1091             continue;
1092
1093           if (var[0]->type == NUMERIC)
1094             msg (MW, _("%s: File contains duplicate label for value %g for "
1095                        "variable %s."),
1096                  handle_get_filename (h), label->value.f, v->name);
1097           else
1098             msg (MW, _("%s: File contains duplicate label for value `%.*s' "
1099                        "for variable %s."),
1100                  handle_get_filename (h), v->width, label->value.s, v->name);
1101         }
1102     }
1103
1104   for (i = 0; i < n_labels; i++)
1105     free (labels[i].label);
1106   free (labels);
1107   free (var);
1108   return 1;
1109
1110 lossage:
1111   if (labels)
1112     {
1113       for (i = 0; i < n_labels; i++)
1114         free (labels[i].label);
1115       free (labels);
1116     }
1117   free (var);
1118   return 0;
1119 }
1120
1121 /* Reads NBYTES bytes from the file represented by H.  If BUF is
1122    non-NULL, uses that as the buffer; otherwise allocates at least
1123    MINALLOC bytes.  Returns a pointer to the buffer on success, NULL
1124    on failure. */
1125 static void *
1126 bufread (struct file_handle * h, void *buf, size_t nbytes, size_t minalloc)
1127 {
1128   struct sfm_fhuser_ext *ext = h->ext;
1129
1130   if (buf == NULL)
1131     buf = xmalloc (max (nbytes, minalloc));
1132   if (1 != fread (buf, nbytes, 1, ext->file))
1133     {
1134       if (ferror (ext->file))
1135         msg (ME, _("%s: Reading system file: %s."),
1136              handle_get_filename (h), strerror (errno));
1137       else
1138         corrupt_msg (ME, _("%s: Unexpected end of file."),
1139                      handle_get_filename (h));
1140       return NULL;
1141     }
1142   return buf;
1143 }
1144
1145 /* Reads a document record, type 6, from system file H, and sets up
1146    the documents and n_documents fields in the associated
1147    dictionary. */
1148 static int
1149 read_documents (struct file_handle * h)
1150 {
1151   struct sfm_fhuser_ext *ext = h->ext;
1152   struct dictionary *dict = ext->dict;
1153   int32 n_lines;
1154   char *documents;
1155
1156   if (dict_get_documents (dict) != NULL)
1157     lose ((ME, _("%s: System file contains multiple "
1158                  "type 6 (document) records."),
1159            handle_get_filename (h)));
1160
1161   assertive_bufread (h, &n_lines, sizeof n_lines, 0);
1162   if (n_lines <= 0)
1163     lose ((ME, _("%s: Number of document lines (%ld) "
1164                  "must be greater than 0."),
1165            handle_get_filename (h), (long) n_lines));
1166
1167   documents = bufread (h, NULL, 80 * n_lines, n_lines * 80 + 1);
1168   /* FIXME?  Run through asciify. */
1169   if (documents == NULL)
1170     return 0;
1171   documents[80 * n_lines] = '\0';
1172   dict_set_documents (dict, documents);
1173   free (documents);
1174   return 1;
1175
1176 lossage:
1177   return 0;
1178 }
1179 \f
1180 /* Data reader. */
1181
1182 /* Reads compressed data into H->BUF and sets other pointers
1183    appropriately.  Returns nonzero only if both no errors occur and
1184    data was read. */
1185 static int
1186 buffer_input (struct file_handle * h)
1187 {
1188   struct sfm_fhuser_ext *ext = h->ext;
1189   size_t amt;
1190
1191   if (ext->buf == NULL)
1192     ext->buf = xmalloc (sizeof *ext->buf * 128);
1193   amt = fread (ext->buf, sizeof *ext->buf, 128, ext->file);
1194   if (ferror (ext->file))
1195     {
1196       msg (ME, _("%s: Error reading file: %s."),
1197            handle_get_filename (h), strerror (errno));
1198       return 0;
1199     }
1200   ext->ptr = ext->buf;
1201   ext->end = &ext->buf[amt];
1202   return amt;
1203 }
1204
1205 /* Reads a single case consisting of compressed data from system file
1206    H into the array TEMP[] according to dictionary DICT, and returns
1207    nonzero only if successful. */
1208 /* Data in system files is compressed in the following manner:
1209    data values are grouped into sets of eight; each of the eight has
1210    one instruction byte, which are output together in an octet; each
1211    byte gives a value for that byte or indicates that the value can be
1212    found following the instructions. */
1213 static int
1214 read_compressed_data (struct file_handle * h, flt64 * temp)
1215 {
1216   struct sfm_fhuser_ext *ext = h->ext;
1217
1218   const unsigned char *p_end = ext->x + sizeof (flt64);
1219   unsigned char *p = ext->y;
1220
1221   const flt64 *temp_beg = temp;
1222   const flt64 *temp_end = &temp[ext->case_size];
1223
1224   for (;;)
1225     {
1226       for (; p < p_end; p++)
1227         switch (*p)
1228           {
1229           case 0:
1230             /* Code 0 is ignored. */
1231             continue;
1232           case 252:
1233             /* Code 252 is end of file. */
1234             if (temp_beg != temp)
1235               lose ((ME, _("%s: Compressed data is corrupted.  Data ends "
1236                      "in partial case."),
1237                      handle_get_filename (h)));
1238             goto lossage;
1239           case 253:
1240             /* Code 253 indicates that the value is stored explicitly
1241                following the instruction bytes. */
1242             if (ext->ptr == NULL || ext->ptr >= ext->end)
1243               if (!buffer_input (h))
1244                 {
1245                   lose ((ME, _("%s: Unexpected end of file."),
1246                          handle_get_filename (h)));
1247                   goto lossage;
1248                 }
1249             memcpy (temp++, ext->ptr++, sizeof *temp);
1250             if (temp >= temp_end)
1251               goto winnage;
1252             break;
1253           case 254:
1254             /* Code 254 indicates a string that is all blanks. */
1255             memset (temp++, ' ', sizeof *temp);
1256             if (temp >= temp_end)
1257               goto winnage;
1258             break;
1259           case 255:
1260             /* Code 255 indicates the system-missing value. */
1261             *temp = ext->sysmis;
1262             if (ext->reverse_endian)
1263               bswap_flt64 (temp);
1264             temp++;
1265             if (temp >= temp_end)
1266               goto winnage;
1267             break;
1268           default:
1269             /* Codes 1 through 251 inclusive are taken to indicate a
1270                value of (BYTE - BIAS), where BYTE is the byte's value
1271                and BIAS is the compression bias (generally 100.0). */
1272             *temp = *p - ext->bias;
1273             if (ext->reverse_endian)
1274               bswap_flt64 (temp);
1275             temp++;
1276             if (temp >= temp_end)
1277               goto winnage;
1278             break;
1279           }
1280
1281       /* We have reached the end of this instruction octet.  Read
1282          another. */
1283       if (ext->ptr == NULL || ext->ptr >= ext->end)
1284         if (!buffer_input (h))
1285           {
1286             if (temp_beg != temp)
1287               lose ((ME, _("%s: Unexpected end of file."),
1288                      handle_get_filename (h)));
1289             goto lossage;
1290           }
1291       memcpy (ext->x, ext->ptr++, sizeof *temp);
1292       p = ext->x;
1293     }
1294
1295   /* Not reached. */
1296   assert (0);
1297
1298 winnage:
1299   /* We have filled up an entire record.  Update state and return
1300      successfully. */
1301   ext->y = ++p;
1302   return 1;
1303
1304 lossage:
1305   /* We have been unsuccessful at filling a record, either through i/o
1306      error or through an end-of-file indication.  Update state and
1307      return unsuccessfully. */
1308   return 0;
1309 }
1310
1311 /* Reads one case from system file H into PERM
1312    according to the instructions given in associated dictionary DICT,
1313    which must have the get.* elements appropriately set.  Returns
1314    nonzero only if successful.  */
1315 int
1316 sfm_read_case (struct file_handle * h, struct ccase *perm, struct dictionary * dict)
1317 {
1318   struct sfm_fhuser_ext *ext = h->ext;
1319
1320   size_t nbytes;
1321   flt64 *temp;
1322
1323   int i;
1324
1325   /* The first concern is to obtain a full case relative to the data
1326      file.  (Cases in the data file have no particular relationship to
1327      cases in the active file.) */
1328   nbytes = sizeof *temp * ext->case_size;
1329   temp = local_alloc (nbytes);
1330
1331   if (ext->compressed == 0)
1332     {
1333       size_t amt = fread (temp, 1, nbytes, ext->file);
1334
1335       if (amt != nbytes)
1336         {
1337           if (ferror (ext->file))
1338             msg (ME, _("%s: Reading system file: %s."),
1339                  handle_get_filename (h), strerror (errno));
1340           else if (amt != 0)
1341             msg (ME, _("%s: Partial record at end of system file."),
1342                  handle_get_filename (h));
1343           goto lossage;
1344         }
1345     }
1346   else if (!read_compressed_data (h, temp))
1347     goto lossage;
1348
1349   /* Translate a case in data file format to a case in active file
1350      format. */
1351   for (i = 0; i < dict_get_var_cnt (dict); i++)
1352     {
1353       struct variable *v = dict_get_var (dict, i);
1354
1355       if (v->get.fv == -1)
1356         continue;
1357
1358       if (v->type == NUMERIC)
1359         {
1360           flt64 src = temp[v->get.fv];
1361           if (ext->reverse_endian)
1362             bswap_flt64 (&src);
1363           case_data_rw (perm, v->fv)->f = src == ext->sysmis ? SYSMIS : src;
1364         }
1365       else
1366         memcpy (case_data_rw (perm, v->fv)->s, &temp[v->get.fv], v->width);
1367     }
1368
1369   local_free (temp);
1370   return 1;
1371
1372 lossage:
1373   local_free (temp);
1374   return 0;
1375 }
1376
1377 static struct fh_ext_class sfm_r_class =
1378 {
1379   3,
1380   N_("reading as a system file"),
1381   sfm_close,
1382 };