src/data/sys-file-reader.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-9, 2000, 2006, 2007 Free Software Foundation, Inc.
   3
   4    This program is free software: you can redistribute it and/or modify
   5    it under the terms of the GNU General Public License as published by
   6    the Free Software Foundation, either version 3 of the License, or
   7    (at your option) any later version.
   8
   9    This program is distributed in the hope that it will be useful,
  10    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12    GNU General Public License for more details.
  13
  14    You should have received a copy of the GNU General Public License
  15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  16
  17 #include <config.h>
  18
  19 #include <data/sys-file-reader.h>
  20 #include <data/sys-file-private.h>
  21
  22 #include <errno.h>
  23 #include <float.h>
  24 #include <inttypes.h>
  25 #include <setjmp.h>
  26 #include <stdlib.h>
  27
  28 #include <libpspp/alloc.h>
  29 #include <libpspp/assertion.h>
  30 #include <libpspp/message.h>
  31 #include <libpspp/compiler.h>
  32 #include <libpspp/magic.h>
  33 #include <libpspp/misc.h>
  34 #include <libpspp/pool.h>
  35 #include <libpspp/str.h>
  36 #include <libpspp/hash.h>
  37 #include <libpspp/array.h>
  38
  39 #include <data/case.h>
  40 #include <data/casereader-provider.h>
  41 #include <data/casereader.h>
  42 #include <data/dictionary.h>
  43 #include <data/file-handle-def.h>
  44 #include <data/file-name.h>
  45 #include <data/format.h>
  46 #include <data/missing-values.h>
  47 #include <data/value-labels.h>
  48 #include <data/variable.h>
  49 #include <data/value.h>
  50
  51 #include "c-ctype.h"
  52 #include "inttostr.h"
  53 #include "minmax.h"
  54 #include "unlocked-io.h"
  55 #include "xsize.h"
  56
  57 #include "gettext.h"
  58 #define _(msgid) gettext (msgid)
  59 #define N_(msgid) (msgid)
  60
  61 /* System file reader. */
  62 struct sfm_reader
  63   {
  64     /* Resource tracking. */
  65     struct pool *pool;          /* All system file state. */
  66     jmp_buf bail_out;           /* longjmp() target for error handling. */
  67
  68     /* File state. */
  69     struct file_handle *fh;     /* File handle. */
  70     FILE *file;                 /* File stream. */
  71     bool error;                 /* I/O or corruption error? */
  72     size_t value_cnt;           /* Number of "union value"s in struct case. */
  73
  74     /* File format. */
  75     enum integer_format integer_format; /* On-disk integer format. */
  76     enum float_format float_format; /* On-disk floating point format. */
  77     int oct_cnt;                /* Number of 8-byte units per case. */
  78     struct sfm_var *sfm_vars;   /* Variables. */
  79     size_t sfm_var_cnt;         /* Number of variables. */
  80     casenumber case_cnt;        /* Number of cases */
  81     bool has_long_var_names;    /* File has a long variable name map */
  82
  83     /* Decompression. */
  84     bool compressed;            /* File is compressed? */
  85     double bias;                /* Compression bias, usually 100.0. */
  86     uint8_t opcodes[8];         /* Current block of opcodes. */
  87     size_t opcode_idx;          /* Next opcode to interpret, 8 if none left. */
  88   };
  89
  90 static struct casereader_class sys_file_casereader_class;
  91
  92 static bool close_reader (struct sfm_reader *);
  93
  94 static struct variable **make_var_by_value_idx (struct sfm_reader *,
  95                                                 struct dictionary *);
  96 static struct variable *lookup_var_by_value_idx (struct sfm_reader *,
  97                                                  struct variable **,
  98                                                  int value_idx);
  99
 100 static void sys_warn (struct sfm_reader *, const char *, ...)
 101      PRINTF_FORMAT (2, 3);
 102
 103 static void sys_error (struct sfm_reader *, const char *, ...)
 104      PRINTF_FORMAT (2, 3)
 105      NO_RETURN;
 106
 107 static void read_bytes (struct sfm_reader *, void *, size_t);
 108 static bool try_read_bytes (struct sfm_reader *, void *, size_t);
 109 static int read_int (struct sfm_reader *);
 110 static double read_float (struct sfm_reader *);
 111 static void read_string (struct sfm_reader *, char *, size_t);
 112 static void skip_bytes (struct sfm_reader *, size_t);
 113
 114 static struct variable_to_value_map *open_variable_to_value_map (
 115   struct sfm_reader *, size_t size);
 116 static void close_variable_to_value_map (struct sfm_reader *r,
 117                                          struct variable_to_value_map *);
 118 static bool read_variable_to_value_map (struct sfm_reader *,
 119                                         struct dictionary *,
 120                                         struct variable_to_value_map *,
 121                                         struct variable **var, char **value,
 122                                         int *warning_cnt);
 123
 124 static bool close_reader (struct sfm_reader *r);
 125 \f
 126 /* Dictionary reader. */
 127
 128 enum which_format
 129   {
 130     PRINT_FORMAT,
 131     WRITE_FORMAT
 132   };
 133
 134 static void read_header (struct sfm_reader *, struct dictionary *,
 135                          int *weight_idx, int *claimed_oct_cnt,
 136                          struct sfm_read_info *);
 137 static void read_variable_record (struct sfm_reader *, struct dictionary *,
 138                                   int *format_warning_cnt);
 139 static void parse_format_spec (struct sfm_reader *, unsigned int,
 140                                enum which_format, struct variable *,
 141                                int *format_warning_cnt);
 142 static void setup_weight (struct sfm_reader *, int weight_idx,
 143                           struct variable **var_by_value_idx,
 144                           struct dictionary *);
 145 static void read_documents (struct sfm_reader *, struct dictionary *);
 146 static void read_value_labels (struct sfm_reader *, struct dictionary *,
 147                                struct variable **var_by_value_idx);
 148
 149 static void read_extension_record (struct sfm_reader *, struct dictionary *,
 150                                    struct sfm_read_info *);
 151 static void read_machine_integer_info (struct sfm_reader *,
 152                                        size_t size, size_t count,
 153                                        struct sfm_read_info *);
 154 static void read_machine_float_info (struct sfm_reader *,
 155                                      size_t size, size_t count);
 156 static void read_display_parameters (struct sfm_reader *,
 157                                      size_t size, size_t count,
 158                                      struct dictionary *);
 159 static void read_long_var_name_map (struct sfm_reader *,
 160                                     size_t size, size_t count,
 161                                     struct dictionary *);
 162 static void read_long_string_map (struct sfm_reader *,
 163                                   size_t size, size_t count,
 164                                   struct dictionary *);
 165
 166
 167 /* Opens the system file designated by file handle FH for
 168    reading.  Reads the system file's dictionary into *DICT.
 169    If INFO is non-null, then it receives additional info about the
 170    system file. */
 171 struct casereader *
 172 sfm_open_reader (struct file_handle *fh, struct dictionary **dict,
 173                  struct sfm_read_info *volatile info)
 174 {
 175   struct sfm_reader *volatile r = NULL;
 176   struct variable **var_by_value_idx;
 177   struct sfm_read_info local_info;
 178   int format_warning_cnt = 0;
 179   int weight_idx;
 180   int claimed_oct_cnt;
 181   int rec_type;
 182
 183   if (!fh_open (fh, FH_REF_FILE, "system file", "rs"))
 184     return NULL;
 185
 186   *dict = dict_create ();
 187
 188   /* Create and initialize reader. */
 189   r = pool_create_container (struct sfm_reader, pool);
 190   r->fh = fh;
 191   r->file = fn_open (fh_get_file_name (fh), "rb");
 192   r->error = false;
 193   r->oct_cnt = 0;
 194   r->has_long_var_names = false;
 195   r->opcode_idx = sizeof r->opcodes;
 196
 197   /* Initialize info. */
 198   if (info == NULL)
 199     info = &local_info;
 200   memset (info, 0, sizeof *info);
 201
 202   if (setjmp (r->bail_out))
 203     {
 204       close_reader (r);
 205       dict_destroy (*dict);
 206       *dict = NULL;
 207       return NULL;
 208     }
 209
 210   if (r->file == NULL)
 211     {
 212       msg (ME, _("Error opening \"%s\" for reading as a system file: %s."),
 213            fh_get_file_name (r->fh), strerror (errno));
 214       longjmp (r->bail_out, 1);
 215     }
 216
 217   /* Read header. */
 218   read_header (r, *dict, &weight_idx, &claimed_oct_cnt, info);
 219
 220   /* Read all the variable definition records. */
 221   rec_type = read_int (r);
 222   while (rec_type == 2)
 223     {
 224       read_variable_record (r, *dict, &format_warning_cnt);
 225       rec_type = read_int (r);
 226     }
 227
 228   /* Figure out the case format. */
 229   var_by_value_idx = make_var_by_value_idx (r, *dict);
 230   setup_weight (r, weight_idx, var_by_value_idx, *dict);
 231
 232   /* Read all the rest of the dictionary records. */
 233   while (rec_type != 999)
 234     {
 235       switch (rec_type)
 236         {
 237         case 3:
 238           read_value_labels (r, *dict, var_by_value_idx);
 239           break;
 240
 241         case 4:
 242           sys_error (r, _("Misplaced type 4 record."));
 243
 244         case 6:
 245           read_documents (r, *dict);
 246           break;
 247
 248         case 7:
 249           read_extension_record (r, *dict, info);
 250           break;
 251
 252         default:
 253           sys_error (r, _("Unrecognized record type %d."), rec_type);
 254         }
 255       rec_type = read_int (r);
 256     }
 257
 258
 259   if ( ! r->has_long_var_names )
 260     {
 261       int i;
 262       for (i = 0; i < dict_get_var_cnt (*dict); i++)
 263         {
 264           struct variable *var = dict_get_var (*dict, i);
 265           char short_name [SHORT_NAME_LEN + 1];
 266           char long_name [SHORT_NAME_LEN + 1];
 267
 268           strcpy (short_name, var_get_name (var));
 269
 270           strcpy (long_name, short_name);
 271           str_lowercase (long_name);
 272
 273           /* Set long name.  Renaming a variable may clear the short
 274              name, but we want to retain it, so re-set it
 275              explicitly. */
 276           dict_rename_var (*dict, var, long_name);
 277           var_set_short_name (var, 0, short_name);
 278         }
 279
 280       r->has_long_var_names = true;
 281     }
 282
 283   /* Read record 999 data, which is just filler. */
 284   read_int (r);
 285
 286   /* Warn if the actual amount of data per case differs from the
 287      amount that the header claims.  SPSS version 13 gets this
 288      wrong when very long strings are involved, so don't warn in
 289      that case. */
 290   if (claimed_oct_cnt != -1 && claimed_oct_cnt != r->oct_cnt
 291       && info->version_major != 13)
 292     sys_warn (r, _("File header claims %d variable positions but "
 293                    "%d were read from file."),
 294               claimed_oct_cnt, r->oct_cnt);
 295
 296   /* Create an index of dictionary variable widths for
 297      sfm_read_case to use.  We cannot use the `struct variable's
 298      from the dictionary we created, because the caller owns the
 299      dictionary and may destroy or modify its variables. */
 300   sfm_dictionary_to_sfm_vars (*dict, &r->sfm_vars, &r->sfm_var_cnt);
 301   pool_register (r->pool, free, r->sfm_vars);
 302
 303   pool_free (r->pool, var_by_value_idx);
 304   r->value_cnt = dict_get_next_value_idx (*dict);
 305   return casereader_create_sequential
 306     (NULL, r->value_cnt,
 307      r->case_cnt == -1 ? CASENUMBER_MAX: r->case_cnt,
 308                                        &sys_file_casereader_class, r);
 309 }
 310
 311 /* Closes a system file after we're done with it.
 312    Returns true if an I/O error has occurred on READER, false
 313    otherwise. */
 314 static bool
 315 close_reader (struct sfm_reader *r)
 316 {
 317   bool error;
 318
 319   if (r == NULL)
 320     return true;
 321
 322   if (r->file)
 323     {
 324       if (fn_close (fh_get_file_name (r->fh), r->file) == EOF)
 325         {
 326           msg (ME, _("Error closing system file \"%s\": %s."),
 327                fh_get_file_name (r->fh), strerror (errno));
 328           r->error = true;
 329         }
 330       r->file = NULL;
 331     }
 332
 333   if (r->fh != NULL)
 334     fh_close (r->fh, "system file", "rs");
 335
 336   error = r->error;
 337   pool_destroy (r->pool);
 338
 339   return !error;
 340 }
 341
 342 /* Destroys READER. */
 343 static void
 344 sys_file_casereader_destroy (struct casereader *reader UNUSED, void *r_)
 345 {
 346   struct sfm_reader *r = r_;
 347   close_reader (r);
 348 }
 349
 350 /* Returns true if FILE is an SPSS system file,
 351    false otherwise. */
 352 bool
 353 sfm_detect (FILE *file)
 354 {
 355   char rec_type[5];
 356
 357   if (fread (rec_type, 4, 1, file) != 1)
 358     return false;
 359   rec_type[4] = '\0';
 360
 361   return !strcmp ("$FL2", rec_type);
 362 }
 363 \f
 364 /* Reads the global header of the system file.
 365    Sets DICT's file label to the system file's label.
 366    Sets *WEIGHT_IDX to 0 if the system file is unweighted,
 367    or to the value index of the weight variable otherwise.
 368    Sets *CLAIMED_OCT_CNT to the number of "octs" (8-byte units)
 369    per case that the file claims to have (although it is not
 370    always correct).
 371    Initializes INFO with header information. */
 372 static void
 373 read_header (struct sfm_reader *r, struct dictionary *dict,
 374              int *weight_idx, int *claimed_oct_cnt,
 375              struct sfm_read_info *info)
 376 {
 377   char rec_type[5];
 378   char eye_catcher[61];
 379   uint8_t raw_layout_code[4];
 380   uint8_t raw_bias[8];
 381   char creation_date[10];
 382   char creation_time[9];
 383   char file_label[65];
 384   struct substring file_label_ss;
 385   struct substring product;
 386
 387   read_string (r, rec_type, sizeof rec_type);
 388   read_string (r, eye_catcher, sizeof eye_catcher);
 389
 390   if (strcmp ("$FL2", rec_type) != 0)
 391     sys_error (r, _("This is not an SPSS system file."));
 392
 393   /* Identify integer format. */
 394   read_bytes (r, raw_layout_code, sizeof raw_layout_code);
 395   if ((!integer_identify (2, raw_layout_code, sizeof raw_layout_code,
 396                           &r->integer_format)
 397        && !integer_identify (3, raw_layout_code, sizeof raw_layout_code,
 398                              &r->integer_format))
 399       || (r->integer_format != INTEGER_MSB_FIRST
 400           && r->integer_format != INTEGER_LSB_FIRST))
 401     sys_error (r, _("This is not an SPSS system file."));
 402
 403   *claimed_oct_cnt = read_int (r);
 404   if (*claimed_oct_cnt < 0 || *claimed_oct_cnt > INT_MAX / 16)
 405     *claimed_oct_cnt = -1;
 406
 407   r->compressed = read_int (r) != 0;
 408
 409   *weight_idx = read_int (r);
 410
 411   r->case_cnt = read_int (r);
 412   if ( r->case_cnt > INT_MAX / 2)
 413     r->case_cnt = -1;
 414
 415
 416   /* Identify floating-point format and obtain compression bias. */
 417   read_bytes (r, raw_bias, sizeof raw_bias);
 418   if (float_identify (100.0, raw_bias, sizeof raw_bias, &r->float_format) == 0)
 419     {
 420       sys_warn (r, _("Compression bias (%g) is not the usual "
 421                      "value of 100, or system file uses unrecognized "
 422                      "floating-point format."),
 423                 r->bias);
 424       if (r->integer_format == INTEGER_MSB_FIRST)
 425         r->float_format = FLOAT_IEEE_DOUBLE_BE;
 426       else
 427         r->float_format = FLOAT_IEEE_DOUBLE_LE;
 428     }
 429   float_convert (r->float_format, raw_bias, FLOAT_NATIVE_DOUBLE, &r->bias);
 430
 431   read_string (r, creation_date, sizeof creation_date);
 432   read_string (r, creation_time, sizeof creation_time);
 433   read_string (r, file_label, sizeof file_label);
 434   skip_bytes (r, 3);
 435
 436   file_label_ss = ss_cstr (file_label);
 437   ss_trim (&file_label_ss, ss_cstr (" "));
 438   if (!ss_is_empty (file_label_ss))
 439     {
 440       ss_data (file_label_ss)[ss_length (file_label_ss)] = '\0';
 441       dict_set_label (dict, ss_data (file_label_ss));
 442     }
 443
 444   strcpy (info->creation_date, creation_date);
 445   strcpy (info->creation_time, creation_time);
 446   info->integer_format = r->integer_format;
 447   info->float_format = r->float_format;
 448   info->compressed = r->compressed;
 449   info->case_cnt = r->case_cnt;
 450
 451   product = ss_cstr (eye_catcher);
 452   ss_match_string (&product, ss_cstr ("@(#) SPSS DATA FILE"));
 453   ss_trim (&product, ss_cstr (" "));
 454   str_copy_buf_trunc (info->product, sizeof info->product,
 455                       ss_data (product), ss_length (product));
 456 }
 457
 458 /* Reads a variable (type 2) record from R and adds the
 459    corresponding variable to DICT.
 460    Also skips past additional variable records for long string
 461    variables. */
 462 static void
 463 read_variable_record (struct sfm_reader *r, struct dictionary *dict,
 464                       int *format_warning_cnt)
 465 {
 466   int width;
 467   int has_variable_label;
 468   int missing_value_code;
 469   int print_format;
 470   int write_format;
 471   char name[9];
 472
 473   struct variable *var;
 474   int nv;
 475
 476   width = read_int (r);
 477   has_variable_label = read_int (r);
 478   missing_value_code = read_int (r);
 479   print_format = read_int (r);
 480   write_format = read_int (r);
 481   read_string (r, name, sizeof name);
 482   name[strcspn (name, " ")] = '\0';
 483
 484   /* Check variable name. */
 485   if (name[0] == '$' || name[0] == '#')
 486     sys_error (r, "Variable name begins with invalid character `%c'.",
 487                name[0]);
 488   if (!var_is_plausible_name (name, false))
 489     sys_error (r, _("Invalid variable name `%s'."), name);
 490
 491   /* Create variable. */
 492   if (width < 0 || width > 255)
 493     sys_error (r, _("Bad variable width %d."), width);
 494   var = dict_create_var (dict, name, width);
 495   if (var == NULL)
 496     sys_error (r,
 497                _("Duplicate variable name `%s' within system file."),
 498                name);
 499
 500   /* Set the short name the same as the long name. */
 501   var_set_short_name (var, 0, var_get_name (var));
 502
 503   /* Get variable label, if any. */
 504   if (has_variable_label != 0 && has_variable_label != 1)
 505     sys_error (r, _("Variable label indicator field is not 0 or 1."));
 506   if (has_variable_label == 1)
 507     {
 508       size_t len;
 509       char label[255 + 1];
 510
 511       len = read_int (r);
 512       if (len >= sizeof label)
 513         sys_error (r, _("Variable %s has label of invalid length %u."),
 514                    name, (unsigned int) len);
 515       read_string (r, label, len + 1);
 516       var_set_label (var, label);
 517
 518       skip_bytes (r, ROUND_UP (len, 4) - len);
 519     }
 520
 521   /* Set missing values. */
 522   if (missing_value_code != 0)
 523     {
 524       struct missing_values mv;
 525       int i;
 526
 527       mv_init (&mv, var_get_width (var));
 528       if (var_is_numeric (var))
 529         {
 530           if (missing_value_code < -3 || missing_value_code > 3
 531               || missing_value_code == -1)
 532             sys_error (r, _("Numeric missing value indicator field is not "
 533                             "-3, -2, 0, 1, 2, or 3."));
 534           if (missing_value_code < 0)
 535             {
 536               double low = read_float (r);
 537               double high = read_float (r);
 538               mv_add_num_range (&mv, low, high);
 539               missing_value_code = -missing_value_code - 2;
 540             }
 541           for (i = 0; i < missing_value_code; i++)
 542             mv_add_num (&mv, read_float (r));
 543         }
 544       else if (var_get_width (var) <= MAX_SHORT_STRING)
 545         {
 546           if (missing_value_code < 1 || missing_value_code > 3)
 547             sys_error (r, _("String missing value indicator field is not "
 548                             "0, 1, 2, or 3."));
 549           for (i = 0; i < missing_value_code; i++)
 550             {
 551               char string[9];
 552               read_string (r, string, sizeof string);
 553               mv_add_str (&mv, string);
 554             }
 555         }
 556       else
 557         sys_error (r, _("Long string variable %s may not have missing "
 558                         "values."), name);
 559       var_set_missing_values (var, &mv);
 560     }
 561
 562   /* Set formats. */
 563   parse_format_spec (r, print_format, PRINT_FORMAT, var, format_warning_cnt);
 564   parse_format_spec (r, write_format, WRITE_FORMAT, var, format_warning_cnt);
 565
 566   /* Account for values.
 567      Skip long string continuation records, if any. */
 568   nv = width == 0 ? 1 : DIV_RND_UP (width, 8);
 569   r->oct_cnt += nv;
 570   if (width > 8)
 571     {
 572       int i;
 573
 574       for (i = 1; i < nv; i++)
 575         {
 576           /* Check for record type 2 and width -1. */
 577           if (read_int (r) != 2 || read_int (r) != -1)
 578             sys_error (r, _("Missing string continuation record."));
 579
 580           /* Skip and ignore remaining continuation data. */
 581           has_variable_label = read_int (r);
 582           missing_value_code = read_int (r);
 583           print_format = read_int (r);
 584           write_format = read_int (r);
 585           read_string (r, name, sizeof name);
 586
 587           /* Variable label fields on continuation records have
 588              been spotted in system files created by "SPSS Power
 589              Macintosh Release 6.1". */
 590           if (has_variable_label)
 591             skip_bytes (r, ROUND_UP (read_int (r), 4));
 592         }
 593     }
 594 }
 595
 596 /* Translates the format spec from sysfile format to internal
 597    format. */
 598 static void
 599 parse_format_spec (struct sfm_reader *r, unsigned int s,
 600                    enum which_format which, struct variable *v,
 601                    int *format_warning_cnt)
 602 {
 603   const int max_format_warnings = 8;
 604   struct fmt_spec f;
 605   uint8_t raw_type = s >> 16;
 606   uint8_t w = s >> 8;
 607   uint8_t d = s;
 608
 609   bool ok;
 610
 611   if (!fmt_from_io (raw_type, &f.type))
 612     sys_error (r, _("Unknown variable format %d."), (int) raw_type);
 613   f.w = w;
 614   f.d = d;
 615
 616   msg_disable ();
 617   ok = fmt_check_output (&f) && fmt_check_width_compat (&f, var_get_width (v));
 618   msg_enable ();
 619
 620   if (ok)
 621     {
 622       if (which == PRINT_FORMAT)
 623         var_set_print_format (v, &f);
 624       else
 625         var_set_write_format (v, &f);
 626     }
 627   else if (*++format_warning_cnt <= max_format_warnings)
 628     {
 629       char fmt_string[FMT_STRING_LEN_MAX + 1];
 630       sys_warn (r, _("%s variable %s has invalid %s format %s."),
 631                 var_is_numeric (v) ? _("Numeric") : _("String"),
 632                 var_get_name (v),
 633                 which == PRINT_FORMAT ? _("print") : _("write"),
 634                 fmt_to_string (&f, fmt_string));
 635
 636       if (*format_warning_cnt == max_format_warnings)
 637         sys_warn (r, _("Suppressing further invalid format warnings."));
 638     }
 639 }
 640
 641 /* Sets the weighting variable in DICT to the variable
 642    corresponding to the given 1-based VALUE_IDX, if VALUE_IDX is
 643    nonzero. */
 644 static void
 645 setup_weight (struct sfm_reader *r, int weight_idx,
 646               struct variable **var_by_value_idx, struct dictionary *dict)
 647 {
 648   if (weight_idx != 0)
 649     {
 650       struct variable *weight_var
 651         = lookup_var_by_value_idx (r, var_by_value_idx, weight_idx);
 652       if (var_is_numeric (weight_var))
 653         dict_set_weight (dict, weight_var);
 654       else
 655         sys_error (r, _("Weighting variable must be numeric."));
 656     }
 657 }
 658
 659 /* Reads a document record, type 6, from system file R, and sets up
 660    the documents and n_documents fields in the associated
 661    dictionary. */
 662 static void
 663 read_documents (struct sfm_reader *r, struct dictionary *dict)
 664 {
 665   int line_cnt;
 666   char *documents;
 667
 668   if (dict_get_documents (dict) != NULL)
 669     sys_error (r, _("Multiple type 6 (document) records."));
 670
 671   line_cnt = read_int (r);
 672   if (line_cnt <= 0)
 673     sys_error (r, _("Number of document lines (%d) "
 674                     "must be greater than 0."), line_cnt);
 675
 676   documents = pool_nmalloc (r->pool, line_cnt + 1, DOC_LINE_LENGTH);
 677   read_string (r, documents, DOC_LINE_LENGTH * line_cnt + 1);
 678   if (strlen (documents) == DOC_LINE_LENGTH * line_cnt)
 679     dict_set_documents (dict, documents);
 680   else
 681     sys_error (r, _("Document line contains null byte."));
 682   pool_free (r->pool, documents);
 683 }
 684
 685 /* Read a type 7 extension record. */
 686 static void
 687 read_extension_record (struct sfm_reader *r, struct dictionary *dict,
 688                        struct sfm_read_info *info)
 689 {
 690   int subtype = read_int (r);
 691   size_t size = read_int (r);
 692   size_t count = read_int (r);
 693   size_t bytes = size * count;
 694
 695   /* Check that SIZE * COUNT + 1 doesn't overflow.  Adding 1
 696      allows an extra byte for a null terminator, used by some
 697      extension processing routines. */
 698   if (size != 0 && size_overflow_p (xsum (1, xtimes (count, size))))
 699     sys_error (r, "Record type 7 subtype %d too large.", subtype);
 700
 701   switch (subtype)
 702     {
 703     case 3:
 704       read_machine_integer_info (r, size, count, info);
 705       return;
 706
 707     case 4:
 708       read_machine_float_info (r, size, count);
 709       return;
 710
 711     case 5:
 712       /* Variable sets information.  We don't use these yet.
 713          They only apply to GUIs; see VARSETS on the APPLY
 714          DICTIONARY command in SPSS documentation. */
 715       break;
 716
 717     case 6:
 718       /* DATE variable information.  We don't use it yet, but we
 719          should. */
 720       break;
 721
 722     case 7:
 723       /* Unknown purpose. */
 724       break;
 725
 726     case 11:
 727       read_display_parameters (r, size, count, dict);
 728       return;
 729
 730     case 13:
 731       read_long_var_name_map (r, size, count, dict);
 732       return;
 733
 734     case 14:
 735       read_long_string_map (r, size, count, dict);
 736       return;
 737
 738     case 16:
 739       /* New in SPSS v14?  Unknown purpose.  */
 740       break;
 741
 742     case 17:
 743       /* Text field that defines variable attributes.  New in
 744          SPSS 14. */
 745       break;
 746
 747     default:
 748       sys_warn (r, _("Unrecognized record type 7, subtype %d."), subtype);
 749       break;
 750     }
 751
 752   skip_bytes (r, bytes);
 753 }
 754
 755 /* Read record type 7, subtype 3. */
 756 static void
 757 read_machine_integer_info (struct sfm_reader *r, size_t size, size_t count,
 758                            struct sfm_read_info *info)
 759 {
 760   int version_major = read_int (r);
 761   int version_minor = read_int (r);
 762   int version_revision = read_int (r);
 763   int machine_code UNUSED = read_int (r);
 764   int float_representation = read_int (r);
 765   int compression_code UNUSED = read_int (r);
 766   int integer_representation = read_int (r);
 767   int character_code UNUSED = read_int (r);
 768
 769   int expected_float_format;
 770   int expected_integer_format;
 771
 772   if (size != 4 || count != 8)
 773     sys_error (r, _("Bad size (%u) or count (%u) field on record type 7, "
 774                     "subtype 3."),
 775                (unsigned int) size, (unsigned int) count);
 776
 777   /* Save version info. */
 778   info->version_major = version_major;
 779   info->version_minor = version_minor;
 780   info->version_revision = version_revision;
 781
 782   /* Check floating point format. */
 783   if (r->float_format == FLOAT_IEEE_DOUBLE_BE
 784       || r->float_format == FLOAT_IEEE_DOUBLE_LE)
 785     expected_float_format = 1;
 786   else if (r->float_format == FLOAT_Z_LONG)
 787     expected_float_format = 2;
 788   else if (r->float_format == FLOAT_VAX_G || r->float_format == FLOAT_VAX_D)
 789     expected_float_format = 3;
 790   else
 791     NOT_REACHED ();
 792   if (float_representation != expected_float_format)
 793     sys_error (r, _("Floating-point representation indicated by "
 794                     "system file (%d) differs from expected (%d)."),
 795                r->float_format, expected_float_format);
 796
 797   /* Check integer format. */
 798   if (r->integer_format == INTEGER_MSB_FIRST)
 799     expected_integer_format = 1;
 800   else if (r->integer_format == INTEGER_LSB_FIRST)
 801     expected_integer_format = 2;
 802   else
 803     NOT_REACHED ();
 804   if (integer_representation != expected_integer_format)
 805     {
 806       static const char *endian[] = {N_("little-endian"), N_("big-endian")};
 807       sys_warn (r, _("Integer format indicated by system file (%s) "
 808                      "differs from expected (%s)."),
 809                 gettext (endian[integer_representation == 1]),
 810                 gettext (endian[expected_integer_format == 1]));
 811     }
 812 }
 813
 814 /* Read record type 7, subtype 4. */
 815 static void
 816 read_machine_float_info (struct sfm_reader *r, size_t size, size_t count)
 817 {
 818   double sysmis = read_float (r);
 819   double highest = read_float (r);
 820   double lowest = read_float (r);
 821
 822   if (size != 8 || count != 3)
 823     sys_error (r, _("Bad size (%u) or count (%u) on extension 4."),
 824                (unsigned int) size, (unsigned int) count);
 825
 826   if (sysmis != SYSMIS)
 827     sys_warn (r, _("File specifies unexpected value %g as SYSMIS."), sysmis);
 828   if (highest != HIGHEST)
 829     sys_warn (r, _("File specifies unexpected value %g as HIGHEST."), highest);
 830   if (lowest != LOWEST)
 831     sys_warn (r, _("File specifies unexpected value %g as LOWEST."), lowest);
 832 }
 833
 834 /* Read record type 7, subtype 11, which specifies how variables
 835    should be displayed in GUI environments. */
 836 static void
 837 read_display_parameters (struct sfm_reader *r, size_t size, size_t count,
 838                          struct dictionary *dict)
 839 {
 840   const size_t n_vars = count / 3 ;
 841   bool warned = false;
 842   int i;
 843
 844   if (count % 3 || n_vars != dict_get_var_cnt (dict))
 845     sys_error (r, _("Bad size (%u) or count (%u) on extension 11."),
 846                (unsigned int) size, (unsigned int) count);
 847
 848   for (i = 0; i < n_vars; ++i)
 849     {
 850       struct variable *v = dict_get_var (dict, i);
 851       int measure = read_int (r);
 852       int width = read_int (r);
 853       int align = read_int (r);
 854
 855       /* SPSS 14 sometimes seems to set string variables' measure
 856          to zero. */
 857       if (0 == measure && var_is_alpha (v))
 858         measure = 1;
 859
 860       if (measure < 1 || measure > 3 || align < 0 || align > 2)
 861         {
 862           if (!warned)
 863             sys_warn (r, _("Invalid variable display parameters.  "
 864                            "Default parameters substituted."));
 865           warned = true;
 866           continue;
 867         }
 868
 869       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
 870                            : measure == 2 ? MEASURE_ORDINAL
 871                            : MEASURE_SCALE));
 872       var_set_display_width (v, width);
 873       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
 874                              : align == 1 ? ALIGN_RIGHT
 875                              : ALIGN_CENTRE));
 876     }
 877 }
 878
 879 /* Reads record type 7, subtype 13, which gives the long name
 880    that corresponds to each short name.  Modifies variable names
 881    in DICT accordingly.  */
 882 static void
 883 read_long_var_name_map (struct sfm_reader *r, size_t size, size_t count,
 884                         struct dictionary *dict)
 885 {
 886   struct variable_to_value_map *map;
 887   struct variable *var;
 888   char *long_name;
 889   int warning_cnt = 0;
 890
 891   map = open_variable_to_value_map (r, size * count);
 892   while (read_variable_to_value_map (r, dict, map, &var, &long_name,
 893                                      &warning_cnt))
 894     {
 895       char **short_names;
 896       size_t short_name_cnt;
 897       size_t i;
 898
 899       /* Validate long name. */
 900       if (!var_is_valid_name (long_name, false))
 901         {
 902           sys_warn (r, _("Long variable mapping from %s to invalid "
 903                          "variable name `%s'."),
 904                     var_get_name (var), long_name);
 905           continue;
 906         }
 907
 908       /* Identify any duplicates. */
 909       if (strcasecmp (var_get_short_name (var, 0), long_name)
 910           && dict_lookup_var (dict, long_name) != NULL)
 911         {
 912           sys_warn (r, _("Duplicate long variable name `%s' "
 913                          "within system file."), long_name);
 914           continue;
 915         }
 916
 917       /* Renaming a variable may clear its short names, but we
 918          want to retain them, so we save them and re-set them
 919          afterward. */
 920       short_name_cnt = var_get_short_name_cnt (var);
 921       short_names = xnmalloc (short_name_cnt, sizeof *short_names);
 922       for (i = 0; i < short_name_cnt; i++)
 923         {
 924           const char *s = var_get_short_name (var, i);
 925           short_names[i] = s != NULL ? xstrdup (s) : NULL;
 926         }
 927
 928       /* Set long name. */
 929       dict_rename_var (dict, var, long_name);
 930
 931       /* Restore short names. */
 932       for (i = 0; i < short_name_cnt; i++)
 933         {
 934           var_set_short_name (var, i, short_names[i]);
 935           free (short_names[i]);
 936         }
 937     }
 938   close_variable_to_value_map (r, map);
 939   r->has_long_var_names = true;
 940 }
 941
 942 /* Reads record type 7, subtype 14, which gives the real length
 943    of each very long string.  Rearranges DICT accordingly. */
 944 static void
 945 read_long_string_map (struct sfm_reader *r, size_t size, size_t count,
 946                       struct dictionary *dict)
 947 {
 948   struct variable_to_value_map *map;
 949   struct variable *var;
 950   char *length_s;
 951   int warning_cnt = 0;
 952
 953   map = open_variable_to_value_map (r, size * count);
 954   while (read_variable_to_value_map (r, dict, map, &var, &length_s,
 955                                      &warning_cnt))
 956     {
 957       size_t idx = var_get_dict_index (var);
 958       long int length;
 959       int segment_cnt;
 960       int i;
 961
 962       /* Get length. */
 963       length = strtol (length_s, NULL, 10);
 964       if (length < 1 || length > MAX_STRING)
 965         {
 966           sys_warn (r, _("%s listed as string of invalid length %s "
 967                          "in very length string record."),
 968                     var_get_name (var), length_s);
 969           continue;
 970         }
 971
 972       /* Check segments. */
 973       segment_cnt = sfm_width_to_segments (length);
 974       if (segment_cnt == 1)
 975         {
 976           sys_warn (r, _("%s listed in very long string record with width %s, "
 977                          "which requires only one segment."),
 978                     var_get_name (var), length_s);
 979           continue;
 980         }
 981       if (idx + segment_cnt > dict_get_var_cnt (dict))
 982         sys_error (r, _("Very long string %s overflows dictionary."),
 983                    var_get_name (var));
 984
 985       /* Get the short names from the segments and check their
 986          lengths. */
 987       for (i = 0; i < segment_cnt; i++)
 988         {
 989           struct variable *seg = dict_get_var (dict, idx + i);
 990           int alloc_width = sfm_segment_alloc_width (length, i);
 991           int width = var_get_width (seg);
 992
 993           if (i > 0)
 994             var_set_short_name (var, i, var_get_short_name (seg, 0));
 995           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
 996             sys_error (r, _("Very long string with width %ld has segment %d "
 997                             "of width %d (expected %d)"),
 998                        length, i, width, alloc_width);
 999         }
1000       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1001       var_set_width (var, length);
1002     }
1003   close_variable_to_value_map (r, map);
1004   dict_compact_values (dict);
1005 }
1006
1007 /* Reads value labels from sysfile H and inserts them into the
1008    associated dictionary. */
1009 static void
1010 read_value_labels (struct sfm_reader *r,
1011                    struct dictionary *dict, struct variable **var_by_value_idx)
1012 {
1013   struct pool *subpool;
1014
1015   struct label
1016     {
1017       char raw_value[8];        /* Value as uninterpreted bytes. */
1018       union value value;        /* Value. */
1019       char *label;              /* Null-terminated label string. */
1020     };
1021
1022   struct label *labels = NULL;
1023   int label_cnt;                /* Number of labels. */
1024
1025   struct variable **var = NULL; /* Associated variables. */
1026   int var_cnt;                  /* Number of associated variables. */
1027
1028   int i;
1029
1030   subpool = pool_create_subpool (r->pool);
1031
1032   /* Read the type 3 record and record its contents.  We can't do
1033      much with the data yet because we don't know whether it is
1034      of numeric or string type. */
1035
1036   /* Read number of labels. */
1037   label_cnt = read_int (r);
1038
1039   if (size_overflow_p (xtimes (label_cnt, sizeof *labels)))
1040     {
1041       sys_warn (r, _("Invalid number of labels: %d.  Ignoring labels."),
1042                 label_cnt);
1043       label_cnt = 0;
1044     }
1045
1046   /* Read each value/label tuple into labels[]. */
1047   labels = pool_nalloc (subpool, label_cnt, sizeof *labels);
1048   for (i = 0; i < label_cnt; i++)
1049     {
1050       struct label *label = labels + i;
1051       unsigned char label_len;
1052       size_t padded_len;
1053
1054       /* Read value. */
1055       read_bytes (r, label->raw_value, sizeof label->raw_value);
1056
1057       /* Read label length. */
1058       read_bytes (r, &label_len, sizeof label_len);
1059       padded_len = ROUND_UP (label_len + 1, 8);
1060
1061       /* Read label, padding. */
1062       label->label = pool_alloc (subpool, padded_len + 1);
1063       read_bytes (r, label->label, padded_len - 1);
1064       label->label[label_len] = 0;
1065     }
1066
1067   /* Now, read the type 4 record that has the list of variables
1068      to which the value labels are to be applied. */
1069
1070   /* Read record type of type 4 record. */
1071   if (read_int (r) != 4)
1072     sys_error (r, _("Variable index record (type 4) does not immediately "
1073                     "follow value label record (type 3) as it should."));
1074
1075   /* Read number of variables associated with value label from type 4
1076      record. */
1077   var_cnt = read_int (r);
1078   if (var_cnt < 1 || var_cnt > dict_get_var_cnt (dict))
1079     sys_error (r, _("Number of variables associated with a value label (%d) "
1080                     "is not between 1 and the number of variables (%u)."),
1081                var_cnt, (unsigned int) dict_get_var_cnt (dict));
1082
1083   /* Read the list of variables. */
1084   var = pool_nalloc (subpool, var_cnt, sizeof *var);
1085   for (i = 0; i < var_cnt; i++)
1086     {
1087       var[i] = lookup_var_by_value_idx (r, var_by_value_idx, read_int (r));
1088       if (var_is_long_string (var[i]))
1089         sys_error (r, _("Value labels are not allowed on long string "
1090                         "variables (%s)."), var_get_name (var[i]));
1091     }
1092
1093   /* Type check the variables. */
1094   for (i = 1; i < var_cnt; i++)
1095     if (var_get_type (var[i]) != var_get_type (var[0]))
1096       sys_error (r, _("Variables associated with value label are not all of "
1097                       "identical type.  Variable %s is %s, but variable "
1098                       "%s is %s."),
1099                  var_get_name (var[0]),
1100                  var_is_numeric (var[0]) ? _("numeric") : _("string"),
1101                  var_get_name (var[i]),
1102                  var_is_numeric (var[i]) ? _("numeric") : _("string"));
1103
1104   /* Fill in labels[].value, now that we know the desired type. */
1105   for (i = 0; i < label_cnt; i++)
1106     {
1107       struct label *label = labels + i;
1108
1109       if (var_is_alpha (var[0]))
1110         buf_copy_rpad (label->value.s, sizeof label->value.s,
1111                        label->raw_value, sizeof label->raw_value);
1112       else
1113         label->value.f = float_get_double (r->float_format, label->raw_value);
1114     }
1115
1116   /* Assign the `value_label's to each variable. */
1117   for (i = 0; i < var_cnt; i++)
1118     {
1119       struct variable *v = var[i];
1120       int j;
1121
1122       /* Add each label to the variable. */
1123       for (j = 0; j < label_cnt; j++)
1124         {
1125           struct label *label = &labels[j];
1126           if (!var_add_value_label (v, &label->value, label->label))
1127             {
1128               if (var_is_numeric (var[0]))
1129                 sys_warn (r, _("Duplicate value label for %g on %s."),
1130                           label->value.f, var_get_name (v));
1131               else
1132                 sys_warn (r, _("Duplicate value label for \"%.*s\" on %s."),
1133                           var_get_width (v), label->value.s,
1134                           var_get_name (v));
1135             }
1136         }
1137     }
1138
1139   pool_destroy (subpool);
1140 }
1141 \f
1142 /* Case reader. */
1143
1144 static void partial_record (struct sfm_reader *r)
1145      NO_RETURN;
1146
1147 static void read_error (struct casereader *, const struct sfm_reader *);
1148
1149 static bool read_case_number (struct sfm_reader *, double *);
1150 static bool read_case_string (struct sfm_reader *, char *, size_t);
1151 static int read_opcode (struct sfm_reader *);
1152 static bool read_compressed_number (struct sfm_reader *, double *);
1153 static bool read_compressed_string (struct sfm_reader *, char *);
1154 static bool read_whole_strings (struct sfm_reader *, char *, size_t);
1155 static bool skip_whole_strings (struct sfm_reader *, size_t);
1156
1157 /* Reads one case from READER's file into C.  Returns true only
1158    if successful. */
1159 static bool
1160 sys_file_casereader_read (struct casereader *reader, void *r_,
1161                           struct ccase *c)
1162 {
1163   struct sfm_reader *r = r_;
1164   int i;
1165
1166   if (r->error)
1167     return false;
1168
1169   case_create (c, r->value_cnt);
1170   if (setjmp (r->bail_out))
1171     {
1172       casereader_force_error (reader);
1173       case_destroy (c);
1174       return false;
1175     }
1176
1177   for (i = 0; i < r->sfm_var_cnt; i++)
1178     {
1179       struct sfm_var *sv = &r->sfm_vars[i];
1180       union value *v = case_data_rw_idx (c, sv->case_index);
1181
1182       if (sv->width == 0)
1183         {
1184           if (!read_case_number (r, &v->f))
1185             goto eof;
1186         }
1187       else
1188         {
1189           if (!read_case_string (r, v->s + sv->offset, sv->width))
1190             goto eof;
1191           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
1192             partial_record (r);
1193         }
1194     }
1195   return true;
1196
1197 eof:
1198   case_destroy (c);
1199   if (i != 0)
1200     partial_record (r);
1201   if (r->case_cnt != -1)
1202     read_error (reader, r);
1203   return false;
1204 }
1205
1206 /* Issues an error that R ends in a partial record. */
1207 static void
1208 partial_record (struct sfm_reader *r)
1209 {
1210   sys_error (r, _("File ends in partial case."));
1211 }
1212
1213 /* Issues an error that an unspecified error occurred SFM, and
1214    marks R tainted. */
1215 static void
1216 read_error (struct casereader *r, const struct sfm_reader *sfm)
1217 {
1218   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
1219   casereader_force_error (r);
1220 }
1221
1222 /* Reads a number from R and stores its value in *D.
1223    If R is compressed, reads a compressed number;
1224    otherwise, reads a number in the regular way.
1225    Returns true if successful, false if end of file is
1226    reached immediately. */
1227 static bool
1228 read_case_number (struct sfm_reader *r, double *d)
1229 {
1230   if (!r->compressed)
1231     {
1232       uint8_t number[8];
1233       if (!try_read_bytes (r, number, sizeof number))
1234         return false;
1235       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
1236       return true;
1237     }
1238   else
1239     return read_compressed_number (r, d);
1240 }
1241
1242 /* Reads LENGTH string bytes from R into S.
1243    Always reads a multiple of 8 bytes; if LENGTH is not a
1244    multiple of 8, then extra bytes are read and discarded without
1245    being written to S.
1246    Reads compressed strings if S is compressed.
1247    Returns true if successful, false if end of file is
1248    reached immediately. */
1249 static bool
1250 read_case_string (struct sfm_reader *r, char *s, size_t length)
1251 {
1252   size_t whole = ROUND_DOWN (length, 8);
1253   size_t partial = length % 8;
1254
1255   if (whole)
1256     {
1257       if (!read_whole_strings (r, s, whole))
1258         return false;
1259     }
1260
1261   if (partial)
1262     {
1263       char bounce[8];
1264       if (!read_whole_strings (r, bounce, sizeof bounce))
1265         {
1266           if (whole)
1267             partial_record (r);
1268           return false;
1269         }
1270       memcpy (s + whole, bounce, partial);
1271     }
1272
1273   return true;
1274 }
1275
1276 /* Reads and returns the next compression opcode from R. */
1277 static int
1278 read_opcode (struct sfm_reader *r)
1279 {
1280   assert (r->compressed);
1281   for (;;)
1282     {
1283       int opcode;
1284       if (r->opcode_idx >= sizeof r->opcodes)
1285         {
1286           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
1287             return -1;
1288           r->opcode_idx = 0;
1289         }
1290       opcode = r->opcodes[r->opcode_idx++];
1291
1292       if (opcode != 0)
1293         return opcode;
1294     }
1295 }
1296
1297 /* Reads a compressed number from R and stores its value in D.
1298    Returns true if successful, false if end of file is
1299    reached immediately. */
1300 static bool
1301 read_compressed_number (struct sfm_reader *r, double *d)
1302 {
1303   int opcode = read_opcode (r);
1304   switch (opcode)
1305     {
1306     case -1:
1307     case 252:
1308       return false;
1309
1310     case 253:
1311       *d = read_float (r);
1312       break;
1313
1314     case 254:
1315       sys_error (r, _("Compressed data is corrupt."));
1316
1317     case 255:
1318       *d = SYSMIS;
1319       break;
1320
1321     default:
1322       *d = opcode - r->bias;
1323       break;
1324     }
1325
1326   return true;
1327 }
1328
1329 /* Reads a compressed 8-byte string segment from R and stores it
1330    in DST.
1331    Returns true if successful, false if end of file is
1332    reached immediately. */
1333 static bool
1334 read_compressed_string (struct sfm_reader *r, char *dst)
1335 {
1336   switch (read_opcode (r))
1337     {
1338     case -1:
1339     case 252:
1340       return false;
1341
1342     case 253:
1343       read_bytes (r, dst, 8);
1344       break;
1345
1346     case 254:
1347       memset (dst, ' ', 8);
1348       break;
1349
1350     default:
1351       sys_error (r, _("Compressed data is corrupt."));
1352     }
1353
1354   return true;
1355 }
1356
1357 /* Reads LENGTH string bytes from R into S.
1358    LENGTH must be a multiple of 8.
1359    Reads compressed strings if S is compressed.
1360    Returns true if successful, false if end of file is
1361    reached immediately. */
1362 static bool
1363 read_whole_strings (struct sfm_reader *r, char *s, size_t length)
1364 {
1365   assert (length % 8 == 0);
1366   if (!r->compressed)
1367     return try_read_bytes (r, s, length);
1368   else
1369     {
1370       size_t ofs;
1371       for (ofs = 0; ofs < length; ofs += 8)
1372         if (!read_compressed_string (r, s + ofs))
1373           {
1374             if (ofs != 0)
1375               partial_record (r);
1376             return false;
1377           }
1378       return true;
1379     }
1380 }
1381
1382 /* Skips LENGTH string bytes from R.
1383    LENGTH must be a multiple of 8.
1384    (LENGTH is also limited to 1024, but that's only because the
1385    current caller never needs more than that many bytes.)
1386    Returns true if successful, false if end of file is
1387    reached immediately. */
1388 static bool
1389 skip_whole_strings (struct sfm_reader *r, size_t length)
1390 {
1391   char buffer[1024];
1392   assert (length < sizeof buffer);
1393   return read_whole_strings (r, buffer, length);
1394 }
1395 \f
1396 /* Creates and returns a table that can be used for translating a value
1397    index into a case to a "struct variable *" for DICT.  Multiple
1398    system file fields reference variables this way.
1399
1400    This table must be created before processing the very long
1401    string extension record, because that record causes some
1402    values to be deleted from the case and the dictionary to be
1403    compacted. */
1404 static struct variable **
1405 make_var_by_value_idx (struct sfm_reader *r, struct dictionary *dict)
1406 {
1407   struct variable **var_by_value_idx;
1408   int value_idx = 0;
1409   int i;
1410
1411   var_by_value_idx = pool_nmalloc (r->pool,
1412                                    r->oct_cnt, sizeof *var_by_value_idx);
1413   for (i = 0; i < dict_get_var_cnt (dict); i++)
1414     {
1415       struct variable *v = dict_get_var (dict, i);
1416       int nv = var_is_numeric (v) ? 1 : DIV_RND_UP (var_get_width (v), 8);
1417       int j;
1418
1419       var_by_value_idx[value_idx++] = v;
1420       for (j = 1; j < nv; j++)
1421         var_by_value_idx[value_idx++] = NULL;
1422     }
1423   assert (value_idx == r->oct_cnt);
1424
1425   return var_by_value_idx;
1426 }
1427
1428 /* Returns the "struct variable" corresponding to the given
1429    1-basd VALUE_IDX in VAR_BY_VALUE_IDX.  Verifies that the index
1430    is valid. */
1431 static struct variable *
1432 lookup_var_by_value_idx (struct sfm_reader *r,
1433                          struct variable **var_by_value_idx, int value_idx)
1434 {
1435   struct variable *var;
1436
1437   if (value_idx < 1 || value_idx > r->oct_cnt)
1438     sys_error (r, _("Variable index %d not in valid range 1...%d."),
1439                value_idx, r->oct_cnt);
1440
1441   var = var_by_value_idx[value_idx - 1];
1442   if (var == NULL)
1443     sys_error (r, _("Variable index %d refers to long string "
1444                     "continuation."),
1445                value_idx);
1446
1447   return var;
1448 }
1449
1450 /* Returns the variable in D with the given SHORT_NAME,
1451    or a null pointer if there is none. */
1452 static struct variable *
1453 lookup_var_by_short_name (struct dictionary *d, const char *short_name)
1454 {
1455   struct variable *var;
1456   size_t var_cnt;
1457   size_t i;
1458
1459   /* First try looking up by full name.  This often succeeds. */
1460   var = dict_lookup_var (d, short_name);
1461   if (var != NULL && !strcasecmp (var_get_short_name (var, 0), short_name))
1462     return var;
1463
1464   /* Iterate through the whole dictionary as a fallback. */
1465   var_cnt = dict_get_var_cnt (d);
1466   for (i = 0; i < var_cnt; i++)
1467     {
1468       var = dict_get_var (d, i);
1469       if (!strcasecmp (var_get_short_name (var, 0), short_name))
1470         return var;
1471     }
1472
1473   return NULL;
1474 }
1475 \f
1476 /* Helpers for reading records that contain "variable=value"
1477    pairs. */
1478
1479 /* State. */
1480 struct variable_to_value_map
1481   {
1482     struct substring buffer;    /* Record contents. */
1483     size_t pos;                 /* Current position in buffer. */
1484   };
1485
1486 /* Reads SIZE bytes into a "variable=value" map for R,
1487    and returns the map. */
1488 static struct variable_to_value_map *
1489 open_variable_to_value_map (struct sfm_reader *r, size_t size)
1490 {
1491   struct variable_to_value_map *map = pool_alloc (r->pool, sizeof *map);
1492   char *buffer = pool_malloc (r->pool, size + 1);
1493   read_bytes (r, buffer, size);
1494   map->buffer = ss_buffer (buffer, size);
1495   map->pos = 0;
1496   return map;
1497 }
1498
1499 /* Closes MAP and frees its storage.
1500    Not really needed, because the pool will free the map anyway,
1501    but can be used to free it earlier. */
1502 static void
1503 close_variable_to_value_map (struct sfm_reader *r,
1504                              struct variable_to_value_map *map)
1505 {
1506   pool_free (r->pool, ss_data (map->buffer));
1507 }
1508
1509 /* Reads the next variable=value pair from MAP.
1510    Looks up the variable in DICT and stores it into *VAR.
1511    Stores a null-terminated value into *VALUE. */
1512 static bool
1513 read_variable_to_value_map (struct sfm_reader *r, struct dictionary *dict,
1514                             struct variable_to_value_map *map,
1515                             struct variable **var, char **value,
1516                             int *warning_cnt)
1517 {
1518   int max_warnings = 5;
1519
1520   for (;;)
1521     {
1522       struct substring short_name_ss, value_ss;
1523
1524       if (!ss_tokenize (map->buffer, ss_cstr ("="), &map->pos, &short_name_ss)
1525           || !ss_tokenize (map->buffer, ss_buffer ("\t\0", 2), &map->pos,
1526                            &value_ss))
1527         {
1528           if (*warning_cnt > max_warnings)
1529             sys_warn (r, _("Suppressed %d additional variable map warnings."),
1530                       *warning_cnt - max_warnings);
1531           return false;
1532         }
1533
1534       map->pos += ss_span (ss_substr (map->buffer, map->pos, SIZE_MAX),
1535                            ss_buffer ("\t\0", 2));
1536
1537       ss_data (short_name_ss)[ss_length (short_name_ss)] = '\0';
1538       *var = lookup_var_by_short_name (dict, ss_data (short_name_ss));
1539       if (*var == NULL)
1540         {
1541           if (++*warning_cnt <= max_warnings)
1542             sys_warn (r, _("Variable map refers to unknown variable %s."),
1543                       ss_data (short_name_ss));
1544           continue;
1545         }
1546
1547       ss_data (value_ss)[ss_length (value_ss)] = '\0';
1548       *value = ss_data (value_ss);
1549
1550       return true;
1551     }
1552 }
1553 \f
1554 /* Messages. */
1555
1556 /* Displays a corruption message. */
1557 static void
1558 sys_msg (struct sfm_reader *r, int class, const char *format, va_list args)
1559 {
1560   struct msg m;
1561   struct string text;
1562
1563   ds_init_empty (&text);
1564   ds_put_format (&text, "\"%s\" near offset 0x%lx: ",
1565                  fh_get_file_name (r->fh), (unsigned long) ftell (r->file));
1566   ds_put_vformat (&text, format, args);
1567
1568   m.category = msg_class_to_category (class);
1569   m.severity = msg_class_to_severity (class);
1570   m.where.file_name = NULL;
1571   m.where.line_number = 0;
1572   m.text = ds_cstr (&text);
1573
1574   msg_emit (&m);
1575 }
1576
1577 /* Displays a warning for the current file position. */
1578 static void
1579 sys_warn (struct sfm_reader *r, const char *format, ...)
1580 {
1581   va_list args;
1582
1583   va_start (args, format);
1584   sys_msg (r, MW, format, args);
1585   va_end (args);
1586 }
1587
1588 /* Displays an error for the current file position,
1589    marks it as in an error state,
1590    and aborts reading it using longjmp. */
1591 static void
1592 sys_error (struct sfm_reader *r, const char *format, ...)
1593 {
1594   va_list args;
1595
1596   va_start (args, format);
1597   sys_msg (r, ME, format, args);
1598   va_end (args);
1599
1600   r->error = true;
1601   longjmp (r->bail_out, 1);
1602 }
1603 \f
1604 /* Reads BYTE_CNT bytes into BUF.
1605    Returns true if exactly BYTE_CNT bytes are successfully read.
1606    Aborts if an I/O error or a partial read occurs.
1607    If EOF_IS_OK, then an immediate end-of-file causes false to be
1608    returned; otherwise, immediate end-of-file causes an abort
1609    too. */
1610 static inline bool
1611 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
1612                    void *buf, size_t byte_cnt)
1613 {
1614   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
1615   if (bytes_read == byte_cnt)
1616     return true;
1617   else if (ferror (r->file))
1618     sys_error (r, _("System error: %s."), strerror (errno));
1619   else if (!eof_is_ok || bytes_read != 0)
1620     sys_error (r, _("Unexpected end of file."));
1621   else
1622     return false;
1623 }
1624
1625 /* Reads BYTE_CNT into BUF.
1626    Aborts upon I/O error or if end-of-file is encountered. */
1627 static void
1628 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
1629 {
1630   read_bytes_internal (r, false, buf, byte_cnt);
1631 }
1632
1633 /* Reads BYTE_CNT bytes into BUF.
1634    Returns true if exactly BYTE_CNT bytes are successfully read.
1635    Returns false if an immediate end-of-file is encountered.
1636    Aborts if an I/O error or a partial read occurs. */
1637 static bool
1638 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
1639 {
1640   return read_bytes_internal (r, true, buf, byte_cnt);
1641 }
1642
1643 /* Reads a 32-bit signed integer from R and returns its value in
1644    host format. */
1645 static int
1646 read_int (struct sfm_reader *r)
1647 {
1648   uint8_t integer[4];
1649   read_bytes (r, integer, sizeof integer);
1650   return integer_get (r->integer_format, integer, sizeof integer);
1651 }
1652
1653 /* Reads a 64-bit floating-point number from R and returns its
1654    value in host format. */
1655 static double
1656 read_float (struct sfm_reader *r)
1657 {
1658   uint8_t number[8];
1659   read_bytes (r, number, sizeof number);
1660   return float_get_double (r->float_format, number);
1661 }
1662
1663 /* Reads exactly SIZE - 1 bytes into BUFFER
1664    and stores a null byte into BUFFER[SIZE - 1]. */
1665 static void
1666 read_string (struct sfm_reader *r, char *buffer, size_t size)
1667 {
1668   assert (size > 0);
1669   read_bytes (r, buffer, size - 1);
1670   buffer[size - 1] = '\0';
1671 }
1672
1673 /* Skips BYTES bytes forward in R. */
1674 static void
1675 skip_bytes (struct sfm_reader *r, size_t bytes)
1676 {
1677   while (bytes > 0)
1678     {
1679       char buffer[1024];
1680       size_t chunk = MIN (sizeof buffer, bytes);
1681       read_bytes (r, buffer, chunk);
1682       bytes -= chunk;
1683     }
1684 }
1685 \f
1686 static struct casereader_class sys_file_casereader_class =
1687   {
1688     sys_file_casereader_read,
1689     sys_file_casereader_destroy,
1690     NULL,
1691     NULL,
1692   };