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