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       /* Older versions (SPSS 9.0) sometimes set the display width
 861          to zero.  This causes confusion especially in the GUI */
 862       if (0 == width)
 863         width = 8;
 864
 865       if (measure < 1 || measure > 3 || align < 0 || align > 2)
 866         {
 867           if (!warned)
 868             sys_warn (r, _("Invalid variable display parameters.  "
 869                            "Default parameters substituted."));
 870           warned = true;
 871           continue;
 872         }
 873
 874       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
 875                            : measure == 2 ? MEASURE_ORDINAL
 876                            : MEASURE_SCALE));
 877       var_set_display_width (v, width);
 878       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
 879                              : align == 1 ? ALIGN_RIGHT
 880                              : ALIGN_CENTRE));
 881     }
 882 }
 883
 884 /* Reads record type 7, subtype 13, which gives the long name
 885    that corresponds to each short name.  Modifies variable names
 886    in DICT accordingly.  */
 887 static void
 888 read_long_var_name_map (struct sfm_reader *r, size_t size, size_t count,
 889                         struct dictionary *dict)
 890 {
 891   struct variable_to_value_map *map;
 892   struct variable *var;
 893   char *long_name;
 894   int warning_cnt = 0;
 895
 896   map = open_variable_to_value_map (r, size * count);
 897   while (read_variable_to_value_map (r, dict, map, &var, &long_name,
 898                                      &warning_cnt))
 899     {
 900       char **short_names;
 901       size_t short_name_cnt;
 902       size_t i;
 903
 904       /* Validate long name. */
 905       if (!var_is_valid_name (long_name, false))
 906         {
 907           sys_warn (r, _("Long variable mapping from %s to invalid "
 908                          "variable name `%s'."),
 909                     var_get_name (var), long_name);
 910           continue;
 911         }
 912
 913       /* Identify any duplicates. */
 914       if (strcasecmp (var_get_short_name (var, 0), long_name)
 915           && dict_lookup_var (dict, long_name) != NULL)
 916         {
 917           sys_warn (r, _("Duplicate long variable name `%s' "
 918                          "within system file."), long_name);
 919           continue;
 920         }
 921
 922       /* Renaming a variable may clear its short names, but we
 923          want to retain them, so we save them and re-set them
 924          afterward. */
 925       short_name_cnt = var_get_short_name_cnt (var);
 926       short_names = xnmalloc (short_name_cnt, sizeof *short_names);
 927       for (i = 0; i < short_name_cnt; i++)
 928         {
 929           const char *s = var_get_short_name (var, i);
 930           short_names[i] = s != NULL ? xstrdup (s) : NULL;
 931         }
 932
 933       /* Set long name. */
 934       dict_rename_var (dict, var, long_name);
 935
 936       /* Restore short names. */
 937       for (i = 0; i < short_name_cnt; i++)
 938         {
 939           var_set_short_name (var, i, short_names[i]);
 940           free (short_names[i]);
 941         }
 942     }
 943   close_variable_to_value_map (r, map);
 944   r->has_long_var_names = true;
 945 }
 946
 947 /* Reads record type 7, subtype 14, which gives the real length
 948    of each very long string.  Rearranges DICT accordingly. */
 949 static void
 950 read_long_string_map (struct sfm_reader *r, size_t size, size_t count,
 951                       struct dictionary *dict)
 952 {
 953   struct variable_to_value_map *map;
 954   struct variable *var;
 955   char *length_s;
 956   int warning_cnt = 0;
 957
 958   map = open_variable_to_value_map (r, size * count);
 959   while (read_variable_to_value_map (r, dict, map, &var, &length_s,
 960                                      &warning_cnt))
 961     {
 962       size_t idx = var_get_dict_index (var);
 963       long int length;
 964       int segment_cnt;
 965       int i;
 966
 967       /* Get length. */
 968       length = strtol (length_s, NULL, 10);
 969       if (length < 1 || length > MAX_STRING)
 970         {
 971           sys_warn (r, _("%s listed as string of invalid length %s "
 972                          "in very length string record."),
 973                     var_get_name (var), length_s);
 974           continue;
 975         }
 976
 977       /* Check segments. */
 978       segment_cnt = sfm_width_to_segments (length);
 979       if (segment_cnt == 1)
 980         {
 981           sys_warn (r, _("%s listed in very long string record with width %s, "
 982                          "which requires only one segment."),
 983                     var_get_name (var), length_s);
 984           continue;
 985         }
 986       if (idx + segment_cnt > dict_get_var_cnt (dict))
 987         sys_error (r, _("Very long string %s overflows dictionary."),
 988                    var_get_name (var));
 989
 990       /* Get the short names from the segments and check their
 991          lengths. */
 992       for (i = 0; i < segment_cnt; i++)
 993         {
 994           struct variable *seg = dict_get_var (dict, idx + i);
 995           int alloc_width = sfm_segment_alloc_width (length, i);
 996           int width = var_get_width (seg);
 997
 998           if (i > 0)
 999             var_set_short_name (var, i, var_get_short_name (seg, 0));
1000           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
1001             sys_error (r, _("Very long string with width %ld has segment %d "
1002                             "of width %d (expected %d)"),
1003                        length, i, width, alloc_width);
1004         }
1005       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1006       var_set_width (var, length);
1007     }
1008   close_variable_to_value_map (r, map);
1009   dict_compact_values (dict);
1010 }
1011
1012 /* Reads value labels from sysfile H and inserts them into the
1013    associated dictionary. */
1014 static void
1015 read_value_labels (struct sfm_reader *r,
1016                    struct dictionary *dict, struct variable **var_by_value_idx)
1017 {
1018   struct pool *subpool;
1019
1020   struct label
1021     {
1022       char raw_value[8];        /* Value as uninterpreted bytes. */
1023       union value value;        /* Value. */
1024       char *label;              /* Null-terminated label string. */
1025     };
1026
1027   struct label *labels = NULL;
1028   int label_cnt;                /* Number of labels. */
1029
1030   struct variable **var = NULL; /* Associated variables. */
1031   int var_cnt;                  /* Number of associated variables. */
1032
1033   int i;
1034
1035   subpool = pool_create_subpool (r->pool);
1036
1037   /* Read the type 3 record and record its contents.  We can't do
1038      much with the data yet because we don't know whether it is
1039      of numeric or string type. */
1040
1041   /* Read number of labels. */
1042   label_cnt = read_int (r);
1043
1044   if (size_overflow_p (xtimes (label_cnt, sizeof *labels)))
1045     {
1046       sys_warn (r, _("Invalid number of labels: %d.  Ignoring labels."),
1047                 label_cnt);
1048       label_cnt = 0;
1049     }
1050
1051   /* Read each value/label tuple into labels[]. */
1052   labels = pool_nalloc (subpool, label_cnt, sizeof *labels);
1053   for (i = 0; i < label_cnt; i++)
1054     {
1055       struct label *label = labels + i;
1056       unsigned char label_len;
1057       size_t padded_len;
1058
1059       /* Read value. */
1060       read_bytes (r, label->raw_value, sizeof label->raw_value);
1061
1062       /* Read label length. */
1063       read_bytes (r, &label_len, sizeof label_len);
1064       padded_len = ROUND_UP (label_len + 1, 8);
1065
1066       /* Read label, padding. */
1067       label->label = pool_alloc (subpool, padded_len + 1);
1068       read_bytes (r, label->label, padded_len - 1);
1069       label->label[label_len] = 0;
1070     }
1071
1072   /* Now, read the type 4 record that has the list of variables
1073      to which the value labels are to be applied. */
1074
1075   /* Read record type of type 4 record. */
1076   if (read_int (r) != 4)
1077     sys_error (r, _("Variable index record (type 4) does not immediately "
1078                     "follow value label record (type 3) as it should."));
1079
1080   /* Read number of variables associated with value label from type 4
1081      record. */
1082   var_cnt = read_int (r);
1083   if (var_cnt < 1 || var_cnt > dict_get_var_cnt (dict))
1084     sys_error (r, _("Number of variables associated with a value label (%d) "
1085                     "is not between 1 and the number of variables (%u)."),
1086                var_cnt, (unsigned int) dict_get_var_cnt (dict));
1087
1088   /* Read the list of variables. */
1089   var = pool_nalloc (subpool, var_cnt, sizeof *var);
1090   for (i = 0; i < var_cnt; i++)
1091     {
1092       var[i] = lookup_var_by_value_idx (r, var_by_value_idx, read_int (r));
1093       if (var_is_long_string (var[i]))
1094         sys_error (r, _("Value labels are not allowed on long string "
1095                         "variables (%s)."), var_get_name (var[i]));
1096     }
1097
1098   /* Type check the variables. */
1099   for (i = 1; i < var_cnt; i++)
1100     if (var_get_type (var[i]) != var_get_type (var[0]))
1101       sys_error (r, _("Variables associated with value label are not all of "
1102                       "identical type.  Variable %s is %s, but variable "
1103                       "%s is %s."),
1104                  var_get_name (var[0]),
1105                  var_is_numeric (var[0]) ? _("numeric") : _("string"),
1106                  var_get_name (var[i]),
1107                  var_is_numeric (var[i]) ? _("numeric") : _("string"));
1108
1109   /* Fill in labels[].value, now that we know the desired type. */
1110   for (i = 0; i < label_cnt; i++)
1111     {
1112       struct label *label = labels + i;
1113
1114       if (var_is_alpha (var[0]))
1115         buf_copy_rpad (label->value.s, sizeof label->value.s,
1116                        label->raw_value, sizeof label->raw_value);
1117       else
1118         label->value.f = float_get_double (r->float_format, label->raw_value);
1119     }
1120
1121   /* Assign the `value_label's to each variable. */
1122   for (i = 0; i < var_cnt; i++)
1123     {
1124       struct variable *v = var[i];
1125       int j;
1126
1127       /* Add each label to the variable. */
1128       for (j = 0; j < label_cnt; j++)
1129         {
1130           struct label *label = &labels[j];
1131           if (!var_add_value_label (v, &label->value, label->label))
1132             {
1133               if (var_is_numeric (var[0]))
1134                 sys_warn (r, _("Duplicate value label for %g on %s."),
1135                           label->value.f, var_get_name (v));
1136               else
1137                 sys_warn (r, _("Duplicate value label for \"%.*s\" on %s."),
1138                           var_get_width (v), label->value.s,
1139                           var_get_name (v));
1140             }
1141         }
1142     }
1143
1144   pool_destroy (subpool);
1145 }
1146 \f
1147 /* Case reader. */
1148
1149 static void partial_record (struct sfm_reader *r)
1150      NO_RETURN;
1151
1152 static void read_error (struct casereader *, const struct sfm_reader *);
1153
1154 static bool read_case_number (struct sfm_reader *, double *);
1155 static bool read_case_string (struct sfm_reader *, char *, size_t);
1156 static int read_opcode (struct sfm_reader *);
1157 static bool read_compressed_number (struct sfm_reader *, double *);
1158 static bool read_compressed_string (struct sfm_reader *, char *);
1159 static bool read_whole_strings (struct sfm_reader *, char *, size_t);
1160 static bool skip_whole_strings (struct sfm_reader *, size_t);
1161
1162 /* Reads one case from READER's file into C.  Returns true only
1163    if successful. */
1164 static bool
1165 sys_file_casereader_read (struct casereader *reader, void *r_,
1166                           struct ccase *c)
1167 {
1168   struct sfm_reader *r = r_;
1169   int i;
1170
1171   if (r->error)
1172     return false;
1173
1174   case_create (c, r->value_cnt);
1175   if (setjmp (r->bail_out))
1176     {
1177       casereader_force_error (reader);
1178       case_destroy (c);
1179       return false;
1180     }
1181
1182   for (i = 0; i < r->sfm_var_cnt; i++)
1183     {
1184       struct sfm_var *sv = &r->sfm_vars[i];
1185       union value *v = case_data_rw_idx (c, sv->case_index);
1186
1187       if (sv->width == 0)
1188         {
1189           if (!read_case_number (r, &v->f))
1190             goto eof;
1191         }
1192       else
1193         {
1194           if (!read_case_string (r, v->s + sv->offset, sv->width))
1195             goto eof;
1196           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
1197             partial_record (r);
1198         }
1199     }
1200   return true;
1201
1202 eof:
1203   case_destroy (c);
1204   if (i != 0)
1205     partial_record (r);
1206   if (r->case_cnt != -1)
1207     read_error (reader, r);
1208   return false;
1209 }
1210
1211 /* Issues an error that R ends in a partial record. */
1212 static void
1213 partial_record (struct sfm_reader *r)
1214 {
1215   sys_error (r, _("File ends in partial case."));
1216 }
1217
1218 /* Issues an error that an unspecified error occurred SFM, and
1219    marks R tainted. */
1220 static void
1221 read_error (struct casereader *r, const struct sfm_reader *sfm)
1222 {
1223   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
1224   casereader_force_error (r);
1225 }
1226
1227 /* Reads a number from R and stores its value in *D.
1228    If R is compressed, reads a compressed number;
1229    otherwise, reads a number in the regular way.
1230    Returns true if successful, false if end of file is
1231    reached immediately. */
1232 static bool
1233 read_case_number (struct sfm_reader *r, double *d)
1234 {
1235   if (!r->compressed)
1236     {
1237       uint8_t number[8];
1238       if (!try_read_bytes (r, number, sizeof number))
1239         return false;
1240       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
1241       return true;
1242     }
1243   else
1244     return read_compressed_number (r, d);
1245 }
1246
1247 /* Reads LENGTH string bytes from R into S.
1248    Always reads a multiple of 8 bytes; if LENGTH is not a
1249    multiple of 8, then extra bytes are read and discarded without
1250    being written to S.
1251    Reads compressed strings if S is compressed.
1252    Returns true if successful, false if end of file is
1253    reached immediately. */
1254 static bool
1255 read_case_string (struct sfm_reader *r, char *s, size_t length)
1256 {
1257   size_t whole = ROUND_DOWN (length, 8);
1258   size_t partial = length % 8;
1259
1260   if (whole)
1261     {
1262       if (!read_whole_strings (r, s, whole))
1263         return false;
1264     }
1265
1266   if (partial)
1267     {
1268       char bounce[8];
1269       if (!read_whole_strings (r, bounce, sizeof bounce))
1270         {
1271           if (whole)
1272             partial_record (r);
1273           return false;
1274         }
1275       memcpy (s + whole, bounce, partial);
1276     }
1277
1278   return true;
1279 }
1280
1281 /* Reads and returns the next compression opcode from R. */
1282 static int
1283 read_opcode (struct sfm_reader *r)
1284 {
1285   assert (r->compressed);
1286   for (;;)
1287     {
1288       int opcode;
1289       if (r->opcode_idx >= sizeof r->opcodes)
1290         {
1291           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
1292             return -1;
1293           r->opcode_idx = 0;
1294         }
1295       opcode = r->opcodes[r->opcode_idx++];
1296
1297       if (opcode != 0)
1298         return opcode;
1299     }
1300 }
1301
1302 /* Reads a compressed number from R and stores its value in D.
1303    Returns true if successful, false if end of file is
1304    reached immediately. */
1305 static bool
1306 read_compressed_number (struct sfm_reader *r, double *d)
1307 {
1308   int opcode = read_opcode (r);
1309   switch (opcode)
1310     {
1311     case -1:
1312     case 252:
1313       return false;
1314
1315     case 253:
1316       *d = read_float (r);
1317       break;
1318
1319     case 254:
1320       sys_error (r, _("Compressed data is corrupt."));
1321
1322     case 255:
1323       *d = SYSMIS;
1324       break;
1325
1326     default:
1327       *d = opcode - r->bias;
1328       break;
1329     }
1330
1331   return true;
1332 }
1333
1334 /* Reads a compressed 8-byte string segment from R and stores it
1335    in DST.
1336    Returns true if successful, false if end of file is
1337    reached immediately. */
1338 static bool
1339 read_compressed_string (struct sfm_reader *r, char *dst)
1340 {
1341   switch (read_opcode (r))
1342     {
1343     case -1:
1344     case 252:
1345       return false;
1346
1347     case 253:
1348       read_bytes (r, dst, 8);
1349       break;
1350
1351     case 254:
1352       memset (dst, ' ', 8);
1353       break;
1354
1355     default:
1356       sys_error (r, _("Compressed data is corrupt."));
1357     }
1358
1359   return true;
1360 }
1361
1362 /* Reads LENGTH string bytes from R into S.
1363    LENGTH must be a multiple of 8.
1364    Reads compressed strings if S is compressed.
1365    Returns true if successful, false if end of file is
1366    reached immediately. */
1367 static bool
1368 read_whole_strings (struct sfm_reader *r, char *s, size_t length)
1369 {
1370   assert (length % 8 == 0);
1371   if (!r->compressed)
1372     return try_read_bytes (r, s, length);
1373   else
1374     {
1375       size_t ofs;
1376       for (ofs = 0; ofs < length; ofs += 8)
1377         if (!read_compressed_string (r, s + ofs))
1378           {
1379             if (ofs != 0)
1380               partial_record (r);
1381             return false;
1382           }
1383       return true;
1384     }
1385 }
1386
1387 /* Skips LENGTH string bytes from R.
1388    LENGTH must be a multiple of 8.
1389    (LENGTH is also limited to 1024, but that's only because the
1390    current caller never needs more than that many bytes.)
1391    Returns true if successful, false if end of file is
1392    reached immediately. */
1393 static bool
1394 skip_whole_strings (struct sfm_reader *r, size_t length)
1395 {
1396   char buffer[1024];
1397   assert (length < sizeof buffer);
1398   return read_whole_strings (r, buffer, length);
1399 }
1400 \f
1401 /* Creates and returns a table that can be used for translating a value
1402    index into a case to a "struct variable *" for DICT.  Multiple
1403    system file fields reference variables this way.
1404
1405    This table must be created before processing the very long
1406    string extension record, because that record causes some
1407    values to be deleted from the case and the dictionary to be
1408    compacted. */
1409 static struct variable **
1410 make_var_by_value_idx (struct sfm_reader *r, struct dictionary *dict)
1411 {
1412   struct variable **var_by_value_idx;
1413   int value_idx = 0;
1414   int i;
1415
1416   var_by_value_idx = pool_nmalloc (r->pool,
1417                                    r->oct_cnt, sizeof *var_by_value_idx);
1418   for (i = 0; i < dict_get_var_cnt (dict); i++)
1419     {
1420       struct variable *v = dict_get_var (dict, i);
1421       int nv = var_is_numeric (v) ? 1 : DIV_RND_UP (var_get_width (v), 8);
1422       int j;
1423
1424       var_by_value_idx[value_idx++] = v;
1425       for (j = 1; j < nv; j++)
1426         var_by_value_idx[value_idx++] = NULL;
1427     }
1428   assert (value_idx == r->oct_cnt);
1429
1430   return var_by_value_idx;
1431 }
1432
1433 /* Returns the "struct variable" corresponding to the given
1434    1-basd VALUE_IDX in VAR_BY_VALUE_IDX.  Verifies that the index
1435    is valid. */
1436 static struct variable *
1437 lookup_var_by_value_idx (struct sfm_reader *r,
1438                          struct variable **var_by_value_idx, int value_idx)
1439 {
1440   struct variable *var;
1441
1442   if (value_idx < 1 || value_idx > r->oct_cnt)
1443     sys_error (r, _("Variable index %d not in valid range 1...%d."),
1444                value_idx, r->oct_cnt);
1445
1446   var = var_by_value_idx[value_idx - 1];
1447   if (var == NULL)
1448     sys_error (r, _("Variable index %d refers to long string "
1449                     "continuation."),
1450                value_idx);
1451
1452   return var;
1453 }
1454
1455 /* Returns the variable in D with the given SHORT_NAME,
1456    or a null pointer if there is none. */
1457 static struct variable *
1458 lookup_var_by_short_name (struct dictionary *d, const char *short_name)
1459 {
1460   struct variable *var;
1461   size_t var_cnt;
1462   size_t i;
1463
1464   /* First try looking up by full name.  This often succeeds. */
1465   var = dict_lookup_var (d, short_name);
1466   if (var != NULL && !strcasecmp (var_get_short_name (var, 0), short_name))
1467     return var;
1468
1469   /* Iterate through the whole dictionary as a fallback. */
1470   var_cnt = dict_get_var_cnt (d);
1471   for (i = 0; i < var_cnt; i++)
1472     {
1473       var = dict_get_var (d, i);
1474       if (!strcasecmp (var_get_short_name (var, 0), short_name))
1475         return var;
1476     }
1477
1478   return NULL;
1479 }
1480 \f
1481 /* Helpers for reading records that contain "variable=value"
1482    pairs. */
1483
1484 /* State. */
1485 struct variable_to_value_map
1486   {
1487     struct substring buffer;    /* Record contents. */
1488     size_t pos;                 /* Current position in buffer. */
1489   };
1490
1491 /* Reads SIZE bytes into a "variable=value" map for R,
1492    and returns the map. */
1493 static struct variable_to_value_map *
1494 open_variable_to_value_map (struct sfm_reader *r, size_t size)
1495 {
1496   struct variable_to_value_map *map = pool_alloc (r->pool, sizeof *map);
1497   char *buffer = pool_malloc (r->pool, size + 1);
1498   read_bytes (r, buffer, size);
1499   map->buffer = ss_buffer (buffer, size);
1500   map->pos = 0;
1501   return map;
1502 }
1503
1504 /* Closes MAP and frees its storage.
1505    Not really needed, because the pool will free the map anyway,
1506    but can be used to free it earlier. */
1507 static void
1508 close_variable_to_value_map (struct sfm_reader *r,
1509                              struct variable_to_value_map *map)
1510 {
1511   pool_free (r->pool, ss_data (map->buffer));
1512 }
1513
1514 /* Reads the next variable=value pair from MAP.
1515    Looks up the variable in DICT and stores it into *VAR.
1516    Stores a null-terminated value into *VALUE. */
1517 static bool
1518 read_variable_to_value_map (struct sfm_reader *r, struct dictionary *dict,
1519                             struct variable_to_value_map *map,
1520                             struct variable **var, char **value,
1521                             int *warning_cnt)
1522 {
1523   int max_warnings = 5;
1524
1525   for (;;)
1526     {
1527       struct substring short_name_ss, value_ss;
1528
1529       if (!ss_tokenize (map->buffer, ss_cstr ("="), &map->pos, &short_name_ss)
1530           || !ss_tokenize (map->buffer, ss_buffer ("\t\0", 2), &map->pos,
1531                            &value_ss))
1532         {
1533           if (*warning_cnt > max_warnings)
1534             sys_warn (r, _("Suppressed %d additional variable map warnings."),
1535                       *warning_cnt - max_warnings);
1536           return false;
1537         }
1538
1539       map->pos += ss_span (ss_substr (map->buffer, map->pos, SIZE_MAX),
1540                            ss_buffer ("\t\0", 2));
1541
1542       ss_data (short_name_ss)[ss_length (short_name_ss)] = '\0';
1543       *var = lookup_var_by_short_name (dict, ss_data (short_name_ss));
1544       if (*var == NULL)
1545         {
1546           if (++*warning_cnt <= max_warnings)
1547             sys_warn (r, _("Variable map refers to unknown variable %s."),
1548                       ss_data (short_name_ss));
1549           continue;
1550         }
1551
1552       ss_data (value_ss)[ss_length (value_ss)] = '\0';
1553       *value = ss_data (value_ss);
1554
1555       return true;
1556     }
1557 }
1558 \f
1559 /* Messages. */
1560
1561 /* Displays a corruption message. */
1562 static void
1563 sys_msg (struct sfm_reader *r, int class, const char *format, va_list args)
1564 {
1565   struct msg m;
1566   struct string text;
1567
1568   ds_init_empty (&text);
1569   ds_put_format (&text, "\"%s\" near offset 0x%lx: ",
1570                  fh_get_file_name (r->fh), (unsigned long) ftell (r->file));
1571   ds_put_vformat (&text, format, args);
1572
1573   m.category = msg_class_to_category (class);
1574   m.severity = msg_class_to_severity (class);
1575   m.where.file_name = NULL;
1576   m.where.line_number = 0;
1577   m.text = ds_cstr (&text);
1578
1579   msg_emit (&m);
1580 }
1581
1582 /* Displays a warning for the current file position. */
1583 static void
1584 sys_warn (struct sfm_reader *r, const char *format, ...)
1585 {
1586   va_list args;
1587
1588   va_start (args, format);
1589   sys_msg (r, MW, format, args);
1590   va_end (args);
1591 }
1592
1593 /* Displays an error for the current file position,
1594    marks it as in an error state,
1595    and aborts reading it using longjmp. */
1596 static void
1597 sys_error (struct sfm_reader *r, const char *format, ...)
1598 {
1599   va_list args;
1600
1601   va_start (args, format);
1602   sys_msg (r, ME, format, args);
1603   va_end (args);
1604
1605   r->error = true;
1606   longjmp (r->bail_out, 1);
1607 }
1608 \f
1609 /* Reads BYTE_CNT bytes into BUF.
1610    Returns true if exactly BYTE_CNT bytes are successfully read.
1611    Aborts if an I/O error or a partial read occurs.
1612    If EOF_IS_OK, then an immediate end-of-file causes false to be
1613    returned; otherwise, immediate end-of-file causes an abort
1614    too. */
1615 static inline bool
1616 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
1617                    void *buf, size_t byte_cnt)
1618 {
1619   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
1620   if (bytes_read == byte_cnt)
1621     return true;
1622   else if (ferror (r->file))
1623     sys_error (r, _("System error: %s."), strerror (errno));
1624   else if (!eof_is_ok || bytes_read != 0)
1625     sys_error (r, _("Unexpected end of file."));
1626   else
1627     return false;
1628 }
1629
1630 /* Reads BYTE_CNT into BUF.
1631    Aborts upon I/O error or if end-of-file is encountered. */
1632 static void
1633 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
1634 {
1635   read_bytes_internal (r, false, buf, byte_cnt);
1636 }
1637
1638 /* Reads BYTE_CNT bytes into BUF.
1639    Returns true if exactly BYTE_CNT bytes are successfully read.
1640    Returns false if an immediate end-of-file is encountered.
1641    Aborts if an I/O error or a partial read occurs. */
1642 static bool
1643 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
1644 {
1645   return read_bytes_internal (r, true, buf, byte_cnt);
1646 }
1647
1648 /* Reads a 32-bit signed integer from R and returns its value in
1649    host format. */
1650 static int
1651 read_int (struct sfm_reader *r)
1652 {
1653   uint8_t integer[4];
1654   read_bytes (r, integer, sizeof integer);
1655   return integer_get (r->integer_format, integer, sizeof integer);
1656 }
1657
1658 /* Reads a 64-bit floating-point number from R and returns its
1659    value in host format. */
1660 static double
1661 read_float (struct sfm_reader *r)
1662 {
1663   uint8_t number[8];
1664   read_bytes (r, number, sizeof number);
1665   return float_get_double (r->float_format, number);
1666 }
1667
1668 /* Reads exactly SIZE - 1 bytes into BUFFER
1669    and stores a null byte into BUFFER[SIZE - 1]. */
1670 static void
1671 read_string (struct sfm_reader *r, char *buffer, size_t size)
1672 {
1673   assert (size > 0);
1674   read_bytes (r, buffer, size - 1);
1675   buffer[size - 1] = '\0';
1676 }
1677
1678 /* Skips BYTES bytes forward in R. */
1679 static void
1680 skip_bytes (struct sfm_reader *r, size_t bytes)
1681 {
1682   while (bytes > 0)
1683     {
1684       char buffer[1024];
1685       size_t chunk = MIN (sizeof buffer, bytes);
1686       read_bytes (r, buffer, chunk);
1687       bytes -= chunk;
1688     }
1689 }
1690 \f
1691 static struct casereader_class sys_file_casereader_class =
1692   {
1693     sys_file_casereader_read,
1694     sys_file_casereader_destroy,
1695     NULL,
1696     NULL,
1697   };