src/data/sys-file-reader.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-9, 2000, 2006, 2007, 2009, 2010 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 "data/attributes.h"
  29 #include "data/case.h"
  30 #include "data/casereader-provider.h"
  31 #include "data/casereader.h"
  32 #include "data/dictionary.h"
  33 #include "data/file-handle-def.h"
  34 #include "data/file-name.h"
  35 #include "data/format.h"
  36 #include "data/missing-values.h"
  37 #include "data/mrset.h"
  38 #include "data/short-names.h"
  39 #include "data/value-labels.h"
  40 #include "data/value.h"
  41 #include "data/variable.h"
  42 #include "libpspp/array.h"
  43 #include "libpspp/assertion.h"
  44 #include "libpspp/compiler.h"
  45 #include "libpspp/i18n.h"
  46 #include "libpspp/message.h"
  47 #include "libpspp/misc.h"
  48 #include "libpspp/pool.h"
  49 #include "libpspp/str.h"
  50 #include "libpspp/stringi-set.h"
  51
  52 #include "gl/c-ctype.h"
  53 #include "gl/inttostr.h"
  54 #include "gl/minmax.h"
  55 #include "gl/unlocked-io.h"
  56 #include "gl/xalloc.h"
  57 #include "gl/xsize.h"
  58
  59 #include "gettext.h"
  60 #define _(msgid) gettext (msgid)
  61 #define N_(msgid) (msgid)
  62
  63 /* System file reader. */
  64 struct sfm_reader
  65   {
  66     /* Resource tracking. */
  67     struct pool *pool;          /* All system file state. */
  68     jmp_buf bail_out;           /* longjmp() target for error handling. */
  69
  70     /* File state. */
  71     struct file_handle *fh;     /* File handle. */
  72     struct fh_lock *lock;       /* Mutual exclusion for file handle. */
  73     FILE *file;                 /* File stream. */
  74     bool error;                 /* I/O or corruption error? */
  75     struct caseproto *proto;    /* Format of output cases. */
  76
  77     /* File format. */
  78     enum integer_format integer_format; /* On-disk integer format. */
  79     enum float_format float_format; /* On-disk floating point format. */
  80     int oct_cnt;                /* Number of 8-byte units per case. */
  81     struct sfm_var *sfm_vars;   /* Variables. */
  82     size_t sfm_var_cnt;         /* Number of variables. */
  83     casenumber case_cnt;        /* Number of cases */
  84     bool has_long_var_names;    /* File has a long variable name map */
  85
  86     /* Decompression. */
  87     bool compressed;            /* File is compressed? */
  88     double bias;                /* Compression bias, usually 100.0. */
  89     uint8_t opcodes[8];         /* Current block of opcodes. */
  90     size_t opcode_idx;          /* Next opcode to interpret, 8 if none left. */
  91     bool corruption_warning;    /* Warned about possible corruption? */
  92   };
  93
  94 static const struct casereader_class sys_file_casereader_class;
  95
  96 static bool close_reader (struct sfm_reader *);
  97
  98 static struct variable **make_var_by_value_idx (struct sfm_reader *,
  99                                                 struct dictionary *);
 100 static struct variable *lookup_var_by_value_idx (struct sfm_reader *,
 101                                                  struct variable **,
 102                                                  int value_idx);
 103 static struct variable *lookup_var_by_short_name (struct dictionary *,
 104                                                   const char *short_name);
 105
 106 static void sys_msg (struct sfm_reader *r, int class,
 107                      const char *format, va_list args)
 108      PRINTF_FORMAT (3, 0);
 109 static void sys_warn (struct sfm_reader *, const char *, ...)
 110      PRINTF_FORMAT (2, 3);
 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 int read_int (struct sfm_reader *);
 118 static double read_float (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 struct text_record *open_text_record (struct sfm_reader *, size_t size);
 123 static void close_text_record (struct sfm_reader *r,
 124                                struct text_record *);
 125 static bool read_variable_to_value_pair (struct sfm_reader *,
 126                                          struct dictionary *,
 127                                          struct text_record *,
 128                                          struct variable **var, char **value);
 129 static void text_warn (struct sfm_reader *r, struct text_record *text,
 130                        const char *format, ...)
 131   PRINTF_FORMAT (3, 4);
 132 static char *text_get_token (struct text_record *,
 133                              struct substring delimiters, char *delimiter);
 134 static bool text_match (struct text_record *, char c);
 135 static bool text_read_variable_name (struct sfm_reader *, struct dictionary *,
 136                                      struct text_record *,
 137                                      struct substring delimiters,
 138                                      struct variable **);
 139 static bool text_read_short_name (struct sfm_reader *, struct dictionary *,
 140                                   struct text_record *,
 141                                   struct substring delimiters,
 142                                   struct variable **);
 143 static const char *text_parse_counted_string (struct sfm_reader *,
 144                                               struct text_record *);
 145 static size_t text_pos (const struct text_record *);
 146
 147 static bool close_reader (struct sfm_reader *r);
 148 \f
 149 /* Dictionary reader. */
 150
 151 enum which_format
 152   {
 153     PRINT_FORMAT,
 154     WRITE_FORMAT
 155   };
 156
 157 static void read_header (struct sfm_reader *, struct dictionary *,
 158                          int *weight_idx, int *claimed_oct_cnt,
 159                          struct sfm_read_info *);
 160 static void read_variable_record (struct sfm_reader *, struct dictionary *,
 161                                   int *format_warning_cnt);
 162 static void parse_format_spec (struct sfm_reader *, unsigned int,
 163                                enum which_format, struct variable *,
 164                                int *format_warning_cnt);
 165 static void setup_weight (struct sfm_reader *, int weight_idx,
 166                           struct variable **var_by_value_idx,
 167                           struct dictionary *);
 168 static void read_documents (struct sfm_reader *, struct dictionary *);
 169 static void read_value_labels (struct sfm_reader *, struct dictionary *,
 170                                struct variable **var_by_value_idx);
 171
 172 static void read_extension_record (struct sfm_reader *, struct dictionary *,
 173                                    struct sfm_read_info *);
 174 static void read_machine_integer_info (struct sfm_reader *,
 175                                        size_t size, size_t count,
 176                                        struct sfm_read_info *,
 177                                        struct dictionary *
 178                                        );
 179 static void read_machine_float_info (struct sfm_reader *,
 180                                      size_t size, size_t count);
 181 static void read_mrsets (struct sfm_reader *, size_t size, size_t count,
 182                          struct dictionary *);
 183 static void read_display_parameters (struct sfm_reader *,
 184                                      size_t size, size_t count,
 185                                      struct dictionary *);
 186 static void read_long_var_name_map (struct sfm_reader *,
 187                                     size_t size, size_t count,
 188                                     struct dictionary *);
 189 static void read_long_string_map (struct sfm_reader *,
 190                                   size_t size, size_t count,
 191                                   struct dictionary *);
 192 static void read_data_file_attributes (struct sfm_reader *,
 193                                        size_t size, size_t count,
 194                                        struct dictionary *);
 195 static void read_variable_attributes (struct sfm_reader *,
 196                                       size_t size, size_t count,
 197                                       struct dictionary *);
 198 static void read_long_string_value_labels (struct sfm_reader *,
 199                                            size_t size, size_t count,
 200                                            struct dictionary *);
 201
 202 /* Convert all the strings in DICT from the dict encoding to UTF8 */
 203 static void
 204 recode_strings (struct dictionary *dict)
 205 {
 206   int i;
 207
 208   const char *enc = dict_get_encoding (dict);
 209
 210   if ( NULL == enc)
 211     enc = get_default_encoding ();
 212
 213   for (i = 0 ; i < dict_get_var_cnt (dict); ++i)
 214     {
 215       /* Convert the long variable name */
 216       struct variable *var = dict_get_var (dict, i);
 217       const char *native_name = var_get_name (var);
 218       char *utf8_name = recode_string (UTF8, enc, native_name, -1);
 219       if ( 0 != strcmp (utf8_name, native_name))
 220         {
 221           if ( NULL == dict_lookup_var (dict, utf8_name))
 222             dict_rename_var (dict, var, utf8_name);
 223           else
 224             msg (MW,
 225              _("Recoded variable name duplicates an existing `%s' within system file."), utf8_name);
 226     }
 227
 228       free (utf8_name);
 229
 230       /* Convert the variable label */
 231       if (var_has_label (var))
 232         {
 233           char *utf8_label = recode_string (UTF8, enc, var_get_label (var), -1);
 234           var_set_label (var, utf8_label);
 235           free (utf8_label);
 236         }
 237
 238       if (var_has_value_labels (var))
 239         {
 240           const struct val_lab *vl = NULL;
 241           const struct val_labs *vlabs = var_get_value_labels (var);
 242
 243           for (vl = val_labs_first (vlabs); vl != NULL; vl = val_labs_next (vlabs, vl))
 244             {
 245               const union value *val = val_lab_get_value (vl);
 246               const char *label = val_lab_get_label (vl);
 247               char *new_label = NULL;
 248
 249               new_label = recode_string (UTF8, enc, label, -1);
 250
 251               var_replace_value_label (var, val, new_label);
 252               free (new_label);
 253             }
 254         }
 255     }
 256 }
 257
 258 /* Opens the system file designated by file handle FH for
 259    reading.  Reads the system file's dictionary into *DICT.
 260    If INFO is non-null, then it receives additional info about the
 261    system file. */
 262 struct casereader *
 263 sfm_open_reader (struct file_handle *fh, struct dictionary **dict,
 264                  struct sfm_read_info *volatile info)
 265 {
 266   struct sfm_reader *volatile r = NULL;
 267   struct variable **var_by_value_idx;
 268   struct sfm_read_info local_info;
 269   int format_warning_cnt = 0;
 270   int weight_idx;
 271   int claimed_oct_cnt;
 272   int rec_type;
 273
 274   *dict = dict_create ();
 275
 276   /* Create and initialize reader. */
 277   r = pool_create_container (struct sfm_reader, pool);
 278   r->fh = fh_ref (fh);
 279   r->lock = NULL;
 280   r->file = NULL;
 281   r->error = false;
 282   r->oct_cnt = 0;
 283   r->has_long_var_names = false;
 284   r->opcode_idx = sizeof r->opcodes;
 285   r->corruption_warning = false;
 286
 287   /* TRANSLATORS: this fragment will be interpolated into
 288      messages in fh_lock() that identify types of files. */
 289   r->lock = fh_lock (fh, FH_REF_FILE, N_("system file"), FH_ACC_READ, false);
 290   if (r->lock == NULL)
 291     goto error;
 292
 293   r->file = fn_open (fh_get_file_name (fh), "rb");
 294   if (r->file == NULL)
 295     {
 296       msg (ME, _("Error opening \"%s\" for reading as a system file: %s."),
 297            fh_get_file_name (r->fh), strerror (errno));
 298       goto error;
 299     }
 300
 301   /* Initialize info. */
 302   if (info == NULL)
 303     info = &local_info;
 304   memset (info, 0, sizeof *info);
 305
 306   if (setjmp (r->bail_out))
 307     goto error;
 308
 309
 310   /* Read header. */
 311   read_header (r, *dict, &weight_idx, &claimed_oct_cnt, info);
 312
 313   /* Read all the variable definition records. */
 314   rec_type = read_int (r);
 315   while (rec_type == 2)
 316     {
 317       read_variable_record (r, *dict, &format_warning_cnt);
 318       rec_type = read_int (r);
 319     }
 320
 321   /* Figure out the case format. */
 322   var_by_value_idx = make_var_by_value_idx (r, *dict);
 323   setup_weight (r, weight_idx, var_by_value_idx, *dict);
 324
 325   /* Read all the rest of the dictionary records. */
 326   while (rec_type != 999)
 327     {
 328       switch (rec_type)
 329         {
 330         case 3:
 331           read_value_labels (r, *dict, var_by_value_idx);
 332           break;
 333
 334         case 4:
 335           sys_error (r, _("Misplaced type 4 record."));
 336
 337         case 6:
 338           read_documents (r, *dict);
 339           break;
 340
 341         case 7:
 342           read_extension_record (r, *dict, info);
 343           break;
 344
 345         default:
 346           sys_error (r, _("Unrecognized record type %d."), rec_type);
 347         }
 348       rec_type = read_int (r);
 349     }
 350
 351
 352   if ( ! r->has_long_var_names )
 353     {
 354       int i;
 355       for (i = 0; i < dict_get_var_cnt (*dict); i++)
 356         {
 357           struct variable *var = dict_get_var (*dict, i);
 358           char short_name[SHORT_NAME_LEN + 1];
 359           char long_name[SHORT_NAME_LEN + 1];
 360
 361           strcpy (short_name, var_get_name (var));
 362
 363           strcpy (long_name, short_name);
 364           str_lowercase (long_name);
 365
 366           /* Set long name.  Renaming a variable may clear the short
 367              name, but we want to retain it, so re-set it
 368              explicitly. */
 369           dict_rename_var (*dict, var, long_name);
 370           var_set_short_name (var, 0, short_name);
 371         }
 372
 373       r->has_long_var_names = true;
 374     }
 375
 376   recode_strings (*dict);
 377
 378   /* Read record 999 data, which is just filler. */
 379   read_int (r);
 380
 381   /* Warn if the actual amount of data per case differs from the
 382      amount that the header claims.  SPSS version 13 gets this
 383      wrong when very long strings are involved, so don't warn in
 384      that case. */
 385   if (claimed_oct_cnt != -1 && claimed_oct_cnt != r->oct_cnt
 386       && info->version_major != 13)
 387     sys_warn (r, _("File header claims %d variable positions but "
 388                    "%d were read from file."),
 389               claimed_oct_cnt, r->oct_cnt);
 390
 391   /* Create an index of dictionary variable widths for
 392      sfm_read_case to use.  We cannot use the `struct variable's
 393      from the dictionary we created, because the caller owns the
 394      dictionary and may destroy or modify its variables. */
 395   sfm_dictionary_to_sfm_vars (*dict, &r->sfm_vars, &r->sfm_var_cnt);
 396   pool_register (r->pool, free, r->sfm_vars);
 397   r->proto = caseproto_ref_pool (dict_get_proto (*dict), r->pool);
 398
 399   pool_free (r->pool, var_by_value_idx);
 400   return casereader_create_sequential
 401     (NULL, r->proto,
 402      r->case_cnt == -1 ? CASENUMBER_MAX: r->case_cnt,
 403                                        &sys_file_casereader_class, r);
 404
 405 error:
 406   close_reader (r);
 407   dict_destroy (*dict);
 408   *dict = NULL;
 409   return NULL;
 410 }
 411
 412 /* Closes a system file after we're done with it.
 413    Returns true if an I/O error has occurred on READER, false
 414    otherwise. */
 415 static bool
 416 close_reader (struct sfm_reader *r)
 417 {
 418   bool error;
 419
 420   if (r == NULL)
 421     return true;
 422
 423   if (r->file)
 424     {
 425       if (fn_close (fh_get_file_name (r->fh), r->file) == EOF)
 426         {
 427           msg (ME, _("Error closing system file \"%s\": %s."),
 428                fh_get_file_name (r->fh), strerror (errno));
 429           r->error = true;
 430         }
 431       r->file = NULL;
 432     }
 433
 434   fh_unlock (r->lock);
 435   fh_unref (r->fh);
 436
 437   error = r->error;
 438   pool_destroy (r->pool);
 439
 440   return !error;
 441 }
 442
 443 /* Destroys READER. */
 444 static void
 445 sys_file_casereader_destroy (struct casereader *reader UNUSED, void *r_)
 446 {
 447   struct sfm_reader *r = r_;
 448   close_reader (r);
 449 }
 450
 451 /* Returns true if FILE is an SPSS system file,
 452    false otherwise. */
 453 bool
 454 sfm_detect (FILE *file)
 455 {
 456   char rec_type[5];
 457
 458   if (fread (rec_type, 4, 1, file) != 1)
 459     return false;
 460   rec_type[4] = '\0';
 461
 462   return !strcmp ("$FL2", rec_type);
 463 }
 464 \f
 465 /* Reads the global header of the system file.
 466    Sets DICT's file label to the system file's label.
 467    Sets *WEIGHT_IDX to 0 if the system file is unweighted,
 468    or to the value index of the weight variable otherwise.
 469    Sets *CLAIMED_OCT_CNT to the number of "octs" (8-byte units)
 470    per case that the file claims to have (although it is not
 471    always correct).
 472    Initializes INFO with header information. */
 473 static void
 474 read_header (struct sfm_reader *r, struct dictionary *dict,
 475              int *weight_idx, int *claimed_oct_cnt,
 476              struct sfm_read_info *info)
 477 {
 478   char rec_type[5];
 479   char eye_catcher[61];
 480   uint8_t raw_layout_code[4];
 481   uint8_t raw_bias[8];
 482   char creation_date[10];
 483   char creation_time[9];
 484   char file_label[65];
 485   struct substring file_label_ss;
 486   struct substring product;
 487
 488   read_string (r, rec_type, sizeof rec_type);
 489   read_string (r, eye_catcher, sizeof eye_catcher);
 490
 491   if (strcmp ("$FL2", rec_type) != 0)
 492     sys_error (r, _("This is not an SPSS system file."));
 493
 494   /* Identify integer format. */
 495   read_bytes (r, raw_layout_code, sizeof raw_layout_code);
 496   if ((!integer_identify (2, raw_layout_code, sizeof raw_layout_code,
 497                           &r->integer_format)
 498        && !integer_identify (3, raw_layout_code, sizeof raw_layout_code,
 499                              &r->integer_format))
 500       || (r->integer_format != INTEGER_MSB_FIRST
 501           && r->integer_format != INTEGER_LSB_FIRST))
 502     sys_error (r, _("This is not an SPSS system file."));
 503
 504   *claimed_oct_cnt = read_int (r);
 505   if (*claimed_oct_cnt < 0 || *claimed_oct_cnt > INT_MAX / 16)
 506     *claimed_oct_cnt = -1;
 507
 508   r->compressed = read_int (r) != 0;
 509
 510   *weight_idx = read_int (r);
 511
 512   r->case_cnt = read_int (r);
 513   if ( r->case_cnt > INT_MAX / 2)
 514     r->case_cnt = -1;
 515
 516
 517   /* Identify floating-point format and obtain compression bias. */
 518   read_bytes (r, raw_bias, sizeof raw_bias);
 519   if (float_identify (100.0, raw_bias, sizeof raw_bias, &r->float_format) == 0)
 520     {
 521       uint8_t zero_bias[8] = { 0, 0, 0, 0, 0, 0, 0, 0 };
 522
 523       if (memcmp (raw_bias, zero_bias, 8))
 524         sys_warn (r, _("Compression bias is not the usual "
 525                        "value of 100, or system file uses unrecognized "
 526                        "floating-point format."));
 527       else
 528         {
 529           /* Some software is known to write all-zeros to this
 530              field.  Such software also writes floating-point
 531              numbers in the format that we expect by default
 532              (it seems that all software most likely does, in
 533              reality), so don't warn in this case. */
 534         }
 535
 536       if (r->integer_format == INTEGER_MSB_FIRST)
 537         r->float_format = FLOAT_IEEE_DOUBLE_BE;
 538       else
 539         r->float_format = FLOAT_IEEE_DOUBLE_LE;
 540     }
 541   float_convert (r->float_format, raw_bias, FLOAT_NATIVE_DOUBLE, &r->bias);
 542
 543   read_string (r, creation_date, sizeof creation_date);
 544   read_string (r, creation_time, sizeof creation_time);
 545   read_string (r, file_label, sizeof file_label);
 546   skip_bytes (r, 3);
 547
 548   file_label_ss = ss_cstr (file_label);
 549   ss_trim (&file_label_ss, ss_cstr (" "));
 550   if (!ss_is_empty (file_label_ss))
 551     {
 552       ss_data (file_label_ss)[ss_length (file_label_ss)] = '\0';
 553       dict_set_label (dict, ss_data (file_label_ss));
 554     }
 555
 556   strcpy (info->creation_date, creation_date);
 557   strcpy (info->creation_time, creation_time);
 558   info->integer_format = r->integer_format;
 559   info->float_format = r->float_format;
 560   info->compressed = r->compressed;
 561   info->case_cnt = r->case_cnt;
 562
 563   product = ss_cstr (eye_catcher);
 564   ss_match_string (&product, ss_cstr ("@(#) SPSS DATA FILE"));
 565   ss_trim (&product, ss_cstr (" "));
 566   str_copy_buf_trunc (info->product, sizeof info->product,
 567                       ss_data (product), ss_length (product));
 568 }
 569
 570 /* Reads a variable (type 2) record from R and adds the
 571    corresponding variable to DICT.
 572    Also skips past additional variable records for long string
 573    variables. */
 574 static void
 575 read_variable_record (struct sfm_reader *r, struct dictionary *dict,
 576                       int *format_warning_cnt)
 577 {
 578   int width;
 579   int has_variable_label;
 580   int missing_value_code;
 581   int print_format;
 582   int write_format;
 583   char name[9];
 584
 585   struct variable *var;
 586   int nv;
 587
 588   width = read_int (r);
 589   has_variable_label = read_int (r);
 590   missing_value_code = read_int (r);
 591   print_format = read_int (r);
 592   write_format = read_int (r);
 593   read_string (r, name, sizeof name);
 594   name[strcspn (name, " ")] = '\0';
 595
 596   /* Check variable name. */
 597   if (name[0] == '$' || name[0] == '#')
 598     sys_error (r, "Variable name begins with invalid character `%c'.",
 599                name[0]);
 600   if (!var_is_plausible_name (name, false))
 601     sys_error (r, _("Invalid variable name `%s'."), name);
 602
 603   /* Create variable. */
 604   if (width < 0 || width > 255)
 605     sys_error (r, _("Bad width %d for variable %s."), width, name);
 606   var = dict_create_var (dict, name, width);
 607   if (var == NULL)
 608     sys_error (r,
 609                _("Duplicate variable name `%s' within system file."),
 610                name);
 611
 612   /* Set the short name the same as the long name. */
 613   var_set_short_name (var, 0, var_get_name (var));
 614
 615   /* Get variable label, if any. */
 616   if (has_variable_label != 0 && has_variable_label != 1)
 617     sys_error (r, _("Variable label indicator field is not 0 or 1."));
 618   if (has_variable_label == 1)
 619     {
 620       size_t len, read_len;
 621       char label[255 + 1];
 622
 623       len = read_int (r);
 624
 625       /* Read up to 255 bytes of label. */
 626       read_len = MIN (sizeof label - 1, len);
 627       read_string (r, label, read_len + 1);
 628       var_set_label (var, label);
 629
 630       /* Skip unread label bytes. */
 631       skip_bytes (r, len - read_len);
 632
 633       /* Skip label padding up to multiple of 4 bytes. */
 634       skip_bytes (r, ROUND_UP (len, 4) - len);
 635     }
 636
 637   /* Set missing values. */
 638   if (missing_value_code != 0)
 639     {
 640       struct missing_values mv;
 641       int i;
 642
 643       mv_init_pool (r->pool, &mv, var_get_width (var));
 644       if (var_is_numeric (var))
 645         {
 646           if (missing_value_code < -3 || missing_value_code > 3
 647               || missing_value_code == -1)
 648             sys_error (r, _("Numeric missing value indicator field is not "
 649                             "-3, -2, 0, 1, 2, or 3."));
 650           if (missing_value_code < 0)
 651             {
 652               double low = read_float (r);
 653               double high = read_float (r);
 654               mv_add_range (&mv, low, high);
 655               missing_value_code = -missing_value_code - 2;
 656             }
 657           for (i = 0; i < missing_value_code; i++)
 658             mv_add_num (&mv, read_float (r));
 659         }
 660       else
 661         {
 662           int mv_width = MAX (width, 8);
 663           union value value;
 664
 665           if (missing_value_code < 1 || missing_value_code > 3)
 666             sys_error (r, _("String missing value indicator field is not "
 667                             "0, 1, 2, or 3."));
 668
 669           value_init (&value, mv_width);
 670           value_set_missing (&value, mv_width);
 671           for (i = 0; i < missing_value_code; i++)
 672             {
 673               uint8_t *s = value_str_rw (&value, mv_width);
 674               read_bytes (r, s, 8);
 675               mv_add_str (&mv, s);
 676             }
 677           value_destroy (&value, mv_width);
 678         }
 679       var_set_missing_values (var, &mv);
 680     }
 681
 682   /* Set formats. */
 683   parse_format_spec (r, print_format, PRINT_FORMAT, var, format_warning_cnt);
 684   parse_format_spec (r, write_format, WRITE_FORMAT, var, format_warning_cnt);
 685
 686   /* Account for values.
 687      Skip long string continuation records, if any. */
 688   nv = width == 0 ? 1 : DIV_RND_UP (width, 8);
 689   r->oct_cnt += nv;
 690   if (width > 8)
 691     {
 692       int i;
 693
 694       for (i = 1; i < nv; i++)
 695         {
 696           /* Check for record type 2 and width -1. */
 697           if (read_int (r) != 2 || read_int (r) != -1)
 698             sys_error (r, _("Missing string continuation record."));
 699
 700           /* Skip and ignore remaining continuation data. */
 701           has_variable_label = read_int (r);
 702           missing_value_code = read_int (r);
 703           print_format = read_int (r);
 704           write_format = read_int (r);
 705           read_string (r, name, sizeof name);
 706
 707           /* Variable label fields on continuation records have
 708              been spotted in system files created by "SPSS Power
 709              Macintosh Release 6.1". */
 710           if (has_variable_label)
 711             skip_bytes (r, ROUND_UP (read_int (r), 4));
 712         }
 713     }
 714 }
 715
 716 /* Translates the format spec from sysfile format to internal
 717    format. */
 718 static void
 719 parse_format_spec (struct sfm_reader *r, unsigned int s,
 720                    enum which_format which, struct variable *v,
 721                    int *format_warning_cnt)
 722 {
 723   const int max_format_warnings = 8;
 724   struct fmt_spec f;
 725   uint8_t raw_type = s >> 16;
 726   uint8_t w = s >> 8;
 727   uint8_t d = s;
 728
 729   bool ok;
 730
 731   if (!fmt_from_io (raw_type, &f.type))
 732     sys_error (r, _("Unknown variable format %"PRIu8"."), raw_type);
 733   f.w = w;
 734   f.d = d;
 735
 736   msg_disable ();
 737   ok = fmt_check_output (&f) && fmt_check_width_compat (&f, var_get_width (v));
 738   msg_enable ();
 739
 740   if (ok)
 741     {
 742       if (which == PRINT_FORMAT)
 743         var_set_print_format (v, &f);
 744       else
 745         var_set_write_format (v, &f);
 746     }
 747   else if (*++format_warning_cnt <= max_format_warnings)
 748     {
 749       char fmt_string[FMT_STRING_LEN_MAX + 1];
 750       sys_warn (r, _("%s variable %s has invalid %s format %s."),
 751                 var_is_numeric (v) ? _("Numeric") : _("String"),
 752                 var_get_name (v),
 753                 which == PRINT_FORMAT ? _("print") : _("write"),
 754                 fmt_to_string (&f, fmt_string));
 755
 756       if (*format_warning_cnt == max_format_warnings)
 757         sys_warn (r, _("Suppressing further invalid format warnings."));
 758     }
 759 }
 760
 761 /* Sets the weighting variable in DICT to the variable
 762    corresponding to the given 1-based VALUE_IDX, if VALUE_IDX is
 763    nonzero. */
 764 static void
 765 setup_weight (struct sfm_reader *r, int weight_idx,
 766               struct variable **var_by_value_idx, struct dictionary *dict)
 767 {
 768   if (weight_idx != 0)
 769     {
 770       struct variable *weight_var
 771         = lookup_var_by_value_idx (r, var_by_value_idx, weight_idx);
 772       if (var_is_numeric (weight_var))
 773         dict_set_weight (dict, weight_var);
 774       else
 775         sys_error (r, _("Weighting variable must be numeric."));
 776     }
 777 }
 778
 779 /* Reads a document record, type 6, from system file R, and sets up
 780    the documents and n_documents fields in the associated
 781    dictionary. */
 782 static void
 783 read_documents (struct sfm_reader *r, struct dictionary *dict)
 784 {
 785   int line_cnt;
 786   char *documents;
 787
 788   if (dict_get_documents (dict) != NULL)
 789     sys_error (r, _("Multiple type 6 (document) records."));
 790
 791   line_cnt = read_int (r);
 792   if (line_cnt <= 0)
 793     sys_error (r, _("Number of document lines (%d) "
 794                     "must be greater than 0."), line_cnt);
 795
 796   documents = pool_nmalloc (r->pool, line_cnt + 1, DOC_LINE_LENGTH);
 797   read_string (r, documents, DOC_LINE_LENGTH * line_cnt + 1);
 798   if (strlen (documents) == DOC_LINE_LENGTH * line_cnt)
 799     dict_set_documents (dict, documents);
 800   else
 801     sys_error (r, _("Document line contains null byte."));
 802   pool_free (r->pool, documents);
 803 }
 804
 805 /* Read a type 7 extension record. */
 806 static void
 807 read_extension_record (struct sfm_reader *r, struct dictionary *dict,
 808                        struct sfm_read_info *info)
 809 {
 810   int subtype = read_int (r);
 811   size_t size = read_int (r);
 812   size_t count = read_int (r);
 813   size_t bytes = size * count;
 814
 815   /* Check that SIZE * COUNT + 1 doesn't overflow.  Adding 1
 816      allows an extra byte for a null terminator, used by some
 817      extension processing routines. */
 818   if (size != 0 && size_overflow_p (xsum (1, xtimes (count, size))))
 819     sys_error (r, "Record type 7 subtype %d too large.", subtype);
 820
 821   switch (subtype)
 822     {
 823     case 3:
 824       read_machine_integer_info (r, size, count, info, dict);
 825       return;
 826
 827     case 4:
 828       read_machine_float_info (r, size, count);
 829       return;
 830
 831     case 5:
 832       /* Variable sets information.  We don't use these yet.
 833          They only apply to GUIs; see VARSETS on the APPLY
 834          DICTIONARY command in SPSS documentation. */
 835       break;
 836
 837     case 6:
 838       /* DATE variable information.  We don't use it yet, but we
 839          should. */
 840       break;
 841
 842     case 7:
 843     case 19:
 844       read_mrsets (r, size, count, dict);
 845       return;
 846
 847     case 8:
 848       /* Used by the SPSS Data Entry software. */
 849       break;
 850
 851     case 11:
 852       read_display_parameters (r, size, count, dict);
 853       return;
 854
 855     case 13:
 856       read_long_var_name_map (r, size, count, dict);
 857       return;
 858
 859     case 14:
 860       read_long_string_map (r, size, count, dict);
 861       return;
 862
 863     case 16:
 864       /* Extended number of cases.  Not important. */
 865       break;
 866
 867     case 17:
 868       read_data_file_attributes (r, size, count, dict);
 869       return;
 870
 871     case 18:
 872       read_variable_attributes (r, size, count, dict);
 873       return;
 874
 875     case 20:
 876       /* New in SPSS 16.  Contains a single string that describes
 877          the character encoding, e.g. "windows-1252". */
 878       {
 879         char *encoding = pool_calloc (r->pool, size, count + 1);
 880         read_string (r, encoding, count + 1);
 881         dict_set_encoding (dict, encoding);
 882         return;
 883       }
 884
 885     case 21:
 886       /* New in SPSS 16.  Encodes value labels for long string
 887          variables. */
 888       read_long_string_value_labels (r, size, count, dict);
 889       return;
 890
 891     default:
 892       sys_warn (r, _("Unrecognized record type 7, subtype %d.  Please send a copy of this file, and the syntax which created it to %s"),
 893                 subtype, PACKAGE_BUGREPORT);
 894       break;
 895     }
 896
 897   skip_bytes (r, bytes);
 898 }
 899
 900 /* Read record type 7, subtype 3. */
 901 static void
 902 read_machine_integer_info (struct sfm_reader *r, size_t size, size_t count,
 903                            struct sfm_read_info *info,
 904                            struct dictionary *dict)
 905 {
 906   int version_major = read_int (r);
 907   int version_minor = read_int (r);
 908   int version_revision = read_int (r);
 909   int machine_code UNUSED = read_int (r);
 910   int float_representation = read_int (r);
 911   int compression_code UNUSED = read_int (r);
 912   int integer_representation = read_int (r);
 913   int character_code = read_int (r);
 914
 915   int expected_float_format;
 916   int expected_integer_format;
 917
 918   if (size != 4 || count != 8)
 919     sys_error (r, _("Bad size (%zu) or count (%zu) field on record type 7, "
 920                     "subtype 3."),
 921                 size, count);
 922
 923   /* Save version info. */
 924   info->version_major = version_major;
 925   info->version_minor = version_minor;
 926   info->version_revision = version_revision;
 927
 928   /* Check floating point format. */
 929   if (r->float_format == FLOAT_IEEE_DOUBLE_BE
 930       || r->float_format == FLOAT_IEEE_DOUBLE_LE)
 931     expected_float_format = 1;
 932   else if (r->float_format == FLOAT_Z_LONG)
 933     expected_float_format = 2;
 934   else if (r->float_format == FLOAT_VAX_G || r->float_format == FLOAT_VAX_D)
 935     expected_float_format = 3;
 936   else
 937     NOT_REACHED ();
 938   if (float_representation != expected_float_format)
 939     sys_error (r, _("Floating-point representation indicated by "
 940                     "system file (%d) differs from expected (%d)."),
 941                r->float_format, expected_float_format);
 942
 943   /* Check integer format. */
 944   if (r->integer_format == INTEGER_MSB_FIRST)
 945     expected_integer_format = 1;
 946   else if (r->integer_format == INTEGER_LSB_FIRST)
 947     expected_integer_format = 2;
 948   else
 949     NOT_REACHED ();
 950   if (integer_representation != expected_integer_format)
 951     {
 952       static const char *const endian[] = {N_("Little Endian"), N_("Big Endian")};
 953       sys_warn (r, _("Integer format indicated by system file (%s) "
 954                      "differs from expected (%s)."),
 955                 gettext (endian[integer_representation == 1]),
 956                 gettext (endian[expected_integer_format == 1]));
 957     }
 958
 959
 960   /*
 961     Record 7 (20) provides a much more reliable way of
 962     setting the encoding.
 963     The character_code is used as a fallback only.
 964   */
 965   if ( NULL == dict_get_encoding (dict))
 966     {
 967       switch (character_code)
 968         {
 969         case 1:
 970           dict_set_encoding (dict, "EBCDIC-US");
 971           break;
 972         case 2:
 973         case 3:
 974           /* These ostensibly mean "7-bit ASCII" and "8-bit ASCII"[sic]
 975              respectively.   However, there are known to be many files
 976              in the wild with character code 2, yet have data which are
 977              clearly not ascii.
 978              Therefore we ignore these values.
 979           */
 980           return;
 981         case 4:
 982           dict_set_encoding (dict, "MS_KANJI");
 983           break;
 984         case 65000:
 985           dict_set_encoding (dict, "UTF-7");
 986           break;
 987         case 65001:
 988           dict_set_encoding (dict, "UTF-8");
 989           break;
 990         default:
 991           {
 992             char enc[100];
 993             snprintf (enc, 100, "CP%d", character_code);
 994             dict_set_encoding (dict, enc);
 995           }
 996           break;
 997         };
 998     }
 999 }
1000
1001 /* Read record type 7, subtype 4. */
1002 static void
1003 read_machine_float_info (struct sfm_reader *r, size_t size, size_t count)
1004 {
1005   double sysmis = read_float (r);
1006   double highest = read_float (r);
1007   double lowest = read_float (r);
1008
1009   if (size != 8 || count != 3)
1010     sys_error (r, _("Bad size (%zu) or count (%zu) on extension 4."),
1011                size, count);
1012
1013   if (sysmis != SYSMIS)
1014     sys_warn (r, _("File specifies unexpected value %g as %s."),
1015               sysmis, "SYSMIS");
1016
1017   if (highest != HIGHEST)
1018     sys_warn (r, _("File specifies unexpected value %g as %s."),
1019               highest, "HIGHEST");
1020
1021   if (lowest != LOWEST)
1022     sys_warn (r, _("File specifies unexpected value %g as %s."),
1023               lowest, "LOWEST");
1024 }
1025
1026 /* Read record type 7, subtype 7 or 19. */
1027 static void
1028 read_mrsets (struct sfm_reader *r, size_t size, size_t count,
1029              struct dictionary *dict)
1030 {
1031   struct text_record *text;
1032   struct mrset *mrset;
1033
1034   text = open_text_record (r, size * count);
1035   for (;;)
1036     {
1037       const char *name, *label, *counted;
1038       struct stringi_set var_names;
1039       size_t allocated_vars;
1040       char delimiter;
1041       int width;
1042
1043       mrset = xzalloc (sizeof *mrset);
1044
1045       name = text_get_token (text, ss_cstr ("="), NULL);
1046       if (name == NULL)
1047         break;
1048       mrset->name = xstrdup (name);
1049
1050       if (text_match (text, 'C'))
1051         {
1052           mrset->type = MRSET_MC;
1053           if (!text_match (text, ' '))
1054             {
1055               sys_warn (r, _("Missing space following 'C' at offset %zu "
1056                              "in MRSETS record"), text_pos (text));
1057               break;
1058             }
1059         }
1060       else if (text_match (text, 'D'))
1061         {
1062           mrset->type = MRSET_MD;
1063           mrset->cat_source = MRSET_VARLABELS;
1064         }
1065       else if (text_match (text, 'E'))
1066         {
1067           char *number;
1068
1069           mrset->type = MRSET_MD;
1070           mrset->cat_source = MRSET_COUNTEDVALUES;
1071           if (!text_match (text, ' '))
1072             {
1073               sys_warn (r, _("Missing space following 'E' at offset %zu "
1074                              "in MRSETS record"), text_pos (text));
1075               break;
1076             }
1077
1078           number = text_get_token (text, ss_cstr (" "), NULL);
1079           if (!strcmp (number, "11"))
1080             mrset->label_from_var_label = true;
1081           else if (strcmp (number, "1"))
1082             sys_warn (r, _("Unexpected label source value \"%s\" "
1083                            "following 'E' at offset %zu in MRSETS record"),
1084                       number, text_pos (text));
1085         }
1086       else
1087         {
1088           sys_warn (r, _("Missing 'C', 'D', or 'E' at offset %zu "
1089                          "in MRSETS record."),
1090                     text_pos (text));
1091           break;
1092         }
1093
1094       if (mrset->type == MRSET_MD)
1095         {
1096           counted = text_parse_counted_string (r, text);
1097           if (counted == NULL)
1098             break;
1099         }
1100
1101       label = text_parse_counted_string (r, text);
1102       if (label == NULL)
1103         break;
1104       mrset->label = label[0] != '\0' ? xstrdup (label) : NULL;
1105
1106       stringi_set_init (&var_names);
1107       allocated_vars = 0;
1108       width = INT_MAX;
1109       do
1110         {
1111           struct variable *var;
1112           const char *var_name;
1113
1114           var_name = text_get_token (text, ss_cstr (" \n"), &delimiter);
1115           if (var_name == NULL)
1116             {
1117               sys_warn (r, _("Missing new-line parsing variable names "
1118                              "at offset %zu in MRSETS record."),
1119                         text_pos (text));
1120               break;
1121             }
1122
1123           var = lookup_var_by_short_name (dict, var_name);
1124           if (var == NULL)
1125             continue;
1126           if (!stringi_set_insert (&var_names, var_name))
1127             {
1128               sys_warn (r, _("Duplicate variable name %s "
1129                              "at offset %zu in MRSETS record."),
1130                         var_name, text_pos (text));
1131               continue;
1132             }
1133
1134           if (mrset->label == NULL && mrset->label_from_var_label
1135               && var_has_label (var))
1136             mrset->label = xstrdup (var_get_label (var));
1137
1138           if (mrset->n_vars
1139               && var_get_type (var) != var_get_type (mrset->vars[0]))
1140             {
1141               sys_warn (r, _("MRSET %s contains both string and "
1142                              "numeric variables."), name);
1143               continue;
1144             }
1145           width = MIN (width, var_get_width (var));
1146
1147           if (mrset->n_vars >= allocated_vars)
1148             mrset->vars = x2nrealloc (mrset->vars, &allocated_vars,
1149                                       sizeof *mrset->vars);
1150           mrset->vars[mrset->n_vars++] = var;
1151         }
1152       while (delimiter != '\n');
1153
1154       if (mrset->n_vars < 2)
1155         {
1156           sys_warn (r, _("MRSET %s has only %zu variables."), mrset->name,
1157                     mrset->n_vars);
1158           mrset_destroy (mrset);
1159           continue;
1160         }
1161
1162       if (mrset->type == MRSET_MD)
1163         {
1164           mrset->width = width;
1165           value_init (&mrset->counted, width);
1166           if (width == 0)
1167             mrset->counted.f = strtod (counted, NULL);
1168           else
1169             value_copy_str_rpad (&mrset->counted, width,
1170                                  (const uint8_t *) counted, ' ');
1171         }
1172
1173       dict_add_mrset (dict, mrset);
1174       mrset = NULL;
1175     }
1176   mrset_destroy (mrset);
1177   close_text_record (r, text);
1178 }
1179
1180 /* Read record type 7, subtype 11, which specifies how variables
1181    should be displayed in GUI environments. */
1182 static void
1183 read_display_parameters (struct sfm_reader *r, size_t size, size_t count,
1184                          struct dictionary *dict)
1185 {
1186   size_t n_vars;
1187   bool includes_width;
1188   bool warned = false;
1189   size_t i;
1190
1191   if (size != 4)
1192     {
1193       sys_warn (r, _("Bad size %zu on extension 11."), size);
1194       skip_bytes (r, size * count);
1195       return;
1196     }
1197
1198   n_vars = dict_get_var_cnt (dict);
1199   if (count == 3 * n_vars)
1200     includes_width = true;
1201   else if (count == 2 * n_vars)
1202     includes_width = false;
1203   else
1204     {
1205       sys_warn (r, _("Extension 11 has bad count %zu (for %zu variables)."),
1206                 count, n_vars);
1207       skip_bytes (r, size * count);
1208       return;
1209     }
1210
1211   for (i = 0; i < n_vars; ++i)
1212     {
1213       struct variable *v = dict_get_var (dict, i);
1214       int measure = read_int (r);
1215       int width = includes_width ? read_int (r) : 0;
1216       int align = read_int (r);
1217
1218       /* SPSS 14 sometimes seems to set string variables' measure
1219          to zero. */
1220       if (0 == measure && var_is_alpha (v))
1221         measure = 1;
1222
1223       if (measure < 1 || measure > 3 || align < 0 || align > 2)
1224         {
1225           if (!warned)
1226             sys_warn (r, _("Invalid variable display parameters "
1227                            "for variable %zu (%s).  "
1228                            "Default parameters substituted."),
1229                       i, var_get_name (v));
1230           warned = true;
1231           continue;
1232         }
1233
1234       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
1235                            : measure == 2 ? MEASURE_ORDINAL
1236                            : MEASURE_SCALE));
1237       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
1238                              : align == 1 ? ALIGN_RIGHT
1239                              : ALIGN_CENTRE));
1240
1241       /* Older versions (SPSS 9.0) sometimes set the display
1242          width to zero.  This causes confusion in the GUI, so
1243          only set the width if it is nonzero. */
1244       if (width > 0)
1245         var_set_display_width (v, width);
1246     }
1247 }
1248
1249 /* Reads record type 7, subtype 13, which gives the long name
1250    that corresponds to each short name.  Modifies variable names
1251    in DICT accordingly.  */
1252 static void
1253 read_long_var_name_map (struct sfm_reader *r, size_t size, size_t count,
1254                         struct dictionary *dict)
1255 {
1256   struct text_record *text;
1257   struct variable *var;
1258   char *long_name;
1259
1260   text = open_text_record (r, size * count);
1261   while (read_variable_to_value_pair (r, dict, text, &var, &long_name))
1262     {
1263       char **short_names;
1264       size_t short_name_cnt;
1265       size_t i;
1266
1267       /* Validate long name. */
1268       if (!var_is_valid_name (long_name, false))
1269         {
1270           sys_warn (r, _("Long variable mapping from %s to invalid "
1271                          "variable name `%s'."),
1272                     var_get_name (var), long_name);
1273           continue;
1274         }
1275
1276       /* Identify any duplicates. */
1277       if (strcasecmp (var_get_short_name (var, 0), long_name)
1278           && dict_lookup_var (dict, long_name) != NULL)
1279         {
1280           sys_warn (r, _("Duplicate long variable name `%s' "
1281                          "within system file."), long_name);
1282           continue;
1283         }
1284
1285       /* Renaming a variable may clear its short names, but we
1286          want to retain them, so we save them and re-set them
1287          afterward. */
1288       short_name_cnt = var_get_short_name_cnt (var);
1289       short_names = xnmalloc (short_name_cnt, sizeof *short_names);
1290       for (i = 0; i < short_name_cnt; i++)
1291         {
1292           const char *s = var_get_short_name (var, i);
1293           short_names[i] = s != NULL ? xstrdup (s) : NULL;
1294         }
1295
1296       /* Set long name. */
1297       dict_rename_var (dict, var, long_name);
1298
1299       /* Restore short names. */
1300       for (i = 0; i < short_name_cnt; i++)
1301         {
1302           var_set_short_name (var, i, short_names[i]);
1303           free (short_names[i]);
1304         }
1305       free (short_names);
1306     }
1307   close_text_record (r, text);
1308   r->has_long_var_names = true;
1309 }
1310
1311 /* Reads record type 7, subtype 14, which gives the real length
1312    of each very long string.  Rearranges DICT accordingly. */
1313 static void
1314 read_long_string_map (struct sfm_reader *r, size_t size, size_t count,
1315                       struct dictionary *dict)
1316 {
1317   struct text_record *text;
1318   struct variable *var;
1319   char *length_s;
1320
1321   text = open_text_record (r, size * count);
1322   while (read_variable_to_value_pair (r, dict, text, &var, &length_s))
1323     {
1324       size_t idx = var_get_dict_index (var);
1325       long int length;
1326       int segment_cnt;
1327       int i;
1328
1329       /* Get length. */
1330       length = strtol (length_s, NULL, 10);
1331       if (length < 1 || length > MAX_STRING)
1332         {
1333           sys_warn (r, _("%s listed as string of invalid length %s "
1334                          "in very length string record."),
1335                     var_get_name (var), length_s);
1336           continue;
1337         }
1338
1339       /* Check segments. */
1340       segment_cnt = sfm_width_to_segments (length);
1341       if (segment_cnt == 1)
1342         {
1343           sys_warn (r, _("%s listed in very long string record with width %s, "
1344                          "which requires only one segment."),
1345                     var_get_name (var), length_s);
1346           continue;
1347         }
1348       if (idx + segment_cnt > dict_get_var_cnt (dict))
1349         sys_error (r, _("Very long string %s overflows dictionary."),
1350                    var_get_name (var));
1351
1352       /* Get the short names from the segments and check their
1353          lengths. */
1354       for (i = 0; i < segment_cnt; i++)
1355         {
1356           struct variable *seg = dict_get_var (dict, idx + i);
1357           int alloc_width = sfm_segment_alloc_width (length, i);
1358           int width = var_get_width (seg);
1359
1360           if (i > 0)
1361             var_set_short_name (var, i, var_get_short_name (seg, 0));
1362           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
1363             sys_error (r, _("Very long string with width %ld has segment %d "
1364                             "of width %d (expected %d)"),
1365                        length, i, width, alloc_width);
1366         }
1367       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1368       var_set_width (var, length);
1369     }
1370   close_text_record (r, text);
1371   dict_compact_values (dict);
1372 }
1373
1374 /* Reads value labels from sysfile H and inserts them into the
1375    associated dictionary. */
1376 static void
1377 read_value_labels (struct sfm_reader *r,
1378                    struct dictionary *dict, struct variable **var_by_value_idx)
1379 {
1380   struct pool *subpool;
1381
1382   struct label
1383     {
1384       uint8_t raw_value[8];        /* Value as uninterpreted bytes. */
1385       union value value;        /* Value. */
1386       char *label;              /* Null-terminated label string. */
1387     };
1388
1389   struct label *labels = NULL;
1390   int label_cnt;                /* Number of labels. */
1391
1392   struct variable **var = NULL; /* Associated variables. */
1393   int var_cnt;                  /* Number of associated variables. */
1394   int max_width;                /* Maximum width of string variables. */
1395
1396   int i;
1397
1398   subpool = pool_create_subpool (r->pool);
1399
1400   /* Read the type 3 record and record its contents.  We can't do
1401      much with the data yet because we don't know whether it is
1402      of numeric or string type. */
1403
1404   /* Read number of labels. */
1405   label_cnt = read_int (r);
1406
1407   if (size_overflow_p (xtimes (label_cnt, sizeof *labels)))
1408     {
1409       sys_warn (r, _("Invalid number of labels: %d.  Ignoring labels."),
1410                 label_cnt);
1411       label_cnt = 0;
1412     }
1413
1414   /* Read each value/label tuple into labels[]. */
1415   labels = pool_nalloc (subpool, label_cnt, sizeof *labels);
1416   for (i = 0; i < label_cnt; i++)
1417     {
1418       struct label *label = labels + i;
1419       unsigned char label_len;
1420       size_t padded_len;
1421
1422       /* Read value. */
1423       read_bytes (r, label->raw_value, sizeof label->raw_value);
1424
1425       /* Read label length. */
1426       read_bytes (r, &label_len, sizeof label_len);
1427       padded_len = ROUND_UP (label_len + 1, 8);
1428
1429       /* Read label, padding. */
1430       label->label = pool_alloc (subpool, padded_len + 1);
1431       read_bytes (r, label->label, padded_len - 1);
1432       label->label[label_len] = 0;
1433     }
1434
1435   /* Now, read the type 4 record that has the list of variables
1436      to which the value labels are to be applied. */
1437
1438   /* Read record type of type 4 record. */
1439   if (read_int (r) != 4)
1440     sys_error (r, _("Variable index record (type 4) does not immediately "
1441                     "follow value label record (type 3) as it should."));
1442
1443   /* Read number of variables associated with value label from type 4
1444      record. */
1445   var_cnt = read_int (r);
1446   if (var_cnt < 1 || var_cnt > dict_get_var_cnt (dict))
1447     sys_error (r, _("Number of variables associated with a value label (%d) "
1448                     "is not between 1 and the number of variables (%zu)."),
1449                var_cnt, dict_get_var_cnt (dict));
1450
1451   /* Read the list of variables. */
1452   var = pool_nalloc (subpool, var_cnt, sizeof *var);
1453   max_width = 0;
1454   for (i = 0; i < var_cnt; i++)
1455     {
1456       var[i] = lookup_var_by_value_idx (r, var_by_value_idx, read_int (r));
1457       if (var_get_width (var[i]) > 8)
1458         sys_error (r, _("Value labels may not be added to long string "
1459                         "variables (e.g. %s) using records types 3 and 4."),
1460                    var_get_name (var[i]));
1461       max_width = MAX (max_width, var_get_width (var[i]));
1462     }
1463
1464   /* Type check the variables. */
1465   for (i = 1; i < var_cnt; i++)
1466     if (var_get_type (var[i]) != var_get_type (var[0]))
1467       sys_error (r, _("Variables associated with value label are not all of "
1468                       "identical type.  Variable %s is %s, but variable "
1469                       "%s is %s."),
1470                  var_get_name (var[0]),
1471                  var_is_numeric (var[0]) ? _("numeric") : _("string"),
1472                  var_get_name (var[i]),
1473                  var_is_numeric (var[i]) ? _("numeric") : _("string"));
1474
1475   /* Fill in labels[].value, now that we know the desired type. */
1476   for (i = 0; i < label_cnt; i++)
1477     {
1478       struct label *label = labels + i;
1479
1480       value_init_pool (subpool, &label->value, max_width);
1481       if (var_is_alpha (var[0]))
1482         u8_buf_copy_rpad (value_str_rw (&label->value, max_width), max_width,
1483                        label->raw_value, sizeof label->raw_value, ' ');
1484       else
1485         label->value.f = float_get_double (r->float_format, label->raw_value);
1486     }
1487
1488   /* Assign the `value_label's to each variable. */
1489   for (i = 0; i < var_cnt; i++)
1490     {
1491       struct variable *v = var[i];
1492       int j;
1493
1494       /* Add each label to the variable. */
1495       for (j = 0; j < label_cnt; j++)
1496         {
1497           struct label *label = &labels[j];
1498           if (!var_add_value_label (v, &label->value, label->label))
1499             {
1500               if (var_is_numeric (var[0]))
1501                 sys_warn (r, _("Duplicate value label for %g on %s."),
1502                           label->value.f, var_get_name (v));
1503               else
1504                 sys_warn (r, _("Duplicate value label for \"%.*s\" on %s."),
1505                           max_width, value_str (&label->value, max_width),
1506                           var_get_name (v));
1507             }
1508         }
1509     }
1510
1511   pool_destroy (subpool);
1512 }
1513
1514 /* Reads a set of custom attributes from TEXT into ATTRS.
1515    ATTRS may be a null pointer, in which case the attributes are
1516    read but discarded. */
1517 static void
1518 read_attributes (struct sfm_reader *r, struct text_record *text,
1519                  struct attrset *attrs)
1520 {
1521   do
1522     {
1523       struct attribute *attr;
1524       char *key;
1525       int index;
1526
1527       /* Parse the key. */
1528       key = text_get_token (text, ss_cstr ("("), NULL);
1529       if (key == NULL)
1530         return;
1531
1532       attr = attribute_create (key);
1533       for (index = 1; ; index++)
1534         {
1535           /* Parse the value. */
1536           char *value;
1537           size_t length;
1538
1539           value = text_get_token (text, ss_cstr ("\n"), NULL);
1540           if (value == NULL)
1541             {
1542               text_warn (r, text, _("Error parsing attribute value %s[%d]"),
1543                          key, index);
1544               break;
1545             }
1546
1547           length = strlen (value);
1548           if (length >= 2 && value[0] == '\'' && value[length - 1] == '\'')
1549             {
1550               value[length - 1] = '\0';
1551               attribute_add_value (attr, value + 1);
1552             }
1553           else
1554             {
1555               text_warn (r, text,
1556                          _("Attribute value %s[%d] is not quoted: %s"),
1557                          key, index, value);
1558               attribute_add_value (attr, value);
1559             }
1560
1561           /* Was this the last value for this attribute? */
1562           if (text_match (text, ')'))
1563             break;
1564         }
1565       if (attrs != NULL)
1566         attrset_add (attrs, attr);
1567       else
1568         attribute_destroy (attr);
1569     }
1570   while (!text_match (text, '/'));
1571 }
1572
1573 /* Reads record type 7, subtype 17, which lists custom
1574    attributes on the data file.  */
1575 static void
1576 read_data_file_attributes (struct sfm_reader *r,
1577                            size_t size, size_t count,
1578                            struct dictionary *dict)
1579 {
1580   struct text_record *text = open_text_record (r, size * count);
1581   read_attributes (r, text, dict_get_attributes (dict));
1582   close_text_record (r, text);
1583 }
1584
1585 static void
1586 skip_long_string_value_labels (struct sfm_reader *r, size_t n_labels)
1587 {
1588   size_t i;
1589
1590   for (i = 0; i < n_labels; i++)
1591     {
1592       size_t value_length, label_length;
1593
1594       value_length = read_int (r);
1595       skip_bytes (r, value_length);
1596       label_length = read_int (r);
1597       skip_bytes (r, label_length);
1598     }
1599 }
1600
1601 static void
1602 read_long_string_value_labels (struct sfm_reader *r,
1603                                size_t size, size_t count,
1604                                struct dictionary *d)
1605 {
1606   const off_t start = ftello (r->file);
1607   while (ftello (r->file) - start < size * count)
1608     {
1609       char var_name[VAR_NAME_LEN + 1];
1610       size_t n_labels, i;
1611       struct variable *v;
1612       union value value;
1613       int var_name_len;
1614       int width;
1615
1616       /* Read header. */
1617       var_name_len = read_int (r);
1618       if (var_name_len > VAR_NAME_LEN)
1619         sys_error (r, _("Variable name length in long string value label "
1620                         "record (%d) exceeds %d-byte limit."),
1621                    var_name_len, VAR_NAME_LEN);
1622       read_string (r, var_name, var_name_len + 1);
1623       width = read_int (r);
1624       n_labels = read_int (r);
1625
1626       v = dict_lookup_var (d, var_name);
1627       if (v == NULL)
1628         {
1629           sys_warn (r, _("Ignoring long string value record for "
1630                          "unknown variable %s."), var_name);
1631           skip_long_string_value_labels (r, n_labels);
1632           continue;
1633         }
1634       if (var_is_numeric (v))
1635         {
1636           sys_warn (r, _("Ignoring long string value record for "
1637                          "numeric variable %s."), var_name);
1638           skip_long_string_value_labels (r, n_labels);
1639           continue;
1640         }
1641       if (width != var_get_width (v))
1642         {
1643           sys_warn (r, _("Ignoring long string value record for variable %s "
1644                          "because the record's width (%d) does not match the "
1645                          "variable's width (%d)"),
1646                     var_name, width, var_get_width (v));
1647           skip_long_string_value_labels (r, n_labels);
1648           continue;
1649         }
1650
1651       /* Read values. */
1652       value_init_pool (r->pool, &value, width);
1653       for (i = 0; i < n_labels; i++)
1654         {
1655           size_t value_length, label_length;
1656           char label[256];
1657           bool skip = false;
1658
1659           /* Read value. */
1660           value_length = read_int (r);
1661           if (value_length == width)
1662             read_bytes (r, value_str_rw (&value, width), width);
1663           else
1664             {
1665               sys_warn (r, _("Ignoring long string value %zu for variable %s, "
1666                              "with width %d, that has bad value width %zu."),
1667                         i, var_get_name (v), width, value_length);
1668               skip_bytes (r, value_length);
1669               skip = true;
1670             }
1671
1672           /* Read label. */
1673           label_length = read_int (r);
1674           read_string (r, label, MIN (sizeof label, label_length + 1));
1675           if (label_length >= sizeof label)
1676             {
1677               /* Skip and silently ignore label text after the
1678                  first 255 bytes.  The maximum documented length
1679                  of a label is 120 bytes so this is more than
1680                  generous. */
1681               skip_bytes (r, (label_length + 1) - sizeof label);
1682             }
1683
1684           if (!skip && !var_add_value_label (v, &value, label))
1685             sys_warn (r, _("Duplicate value label for \"%.*s\" on %s."),
1686                       width, value_str (&value, width), var_get_name (v));
1687         }
1688     }
1689 }
1690
1691
1692 /* Reads record type 7, subtype 18, which lists custom
1693    attributes on individual variables.  */
1694 static void
1695 read_variable_attributes (struct sfm_reader *r,
1696                           size_t size, size_t count,
1697                           struct dictionary *dict)
1698 {
1699   struct text_record *text = open_text_record (r, size * count);
1700   for (;;)
1701     {
1702       struct variable *var;
1703       if (!text_read_variable_name (r, dict, text, ss_cstr (":"), &var))
1704         break;
1705       read_attributes (r, text, var != NULL ? var_get_attributes (var) : NULL);
1706     }
1707   close_text_record (r, text);
1708 }
1709
1710 \f
1711 /* Case reader. */
1712
1713 static void partial_record (struct sfm_reader *r)
1714      NO_RETURN;
1715
1716 static void read_error (struct casereader *, const struct sfm_reader *);
1717
1718 static bool read_case_number (struct sfm_reader *, double *);
1719 static bool read_case_string (struct sfm_reader *, uint8_t *, size_t);
1720 static int read_opcode (struct sfm_reader *);
1721 static bool read_compressed_number (struct sfm_reader *, double *);
1722 static bool read_compressed_string (struct sfm_reader *, uint8_t *);
1723 static bool read_whole_strings (struct sfm_reader *, uint8_t *, size_t);
1724 static bool skip_whole_strings (struct sfm_reader *, size_t);
1725
1726 /* Reads and returns one case from READER's file.  Returns a null
1727    pointer if not successful. */
1728 static struct ccase *
1729 sys_file_casereader_read (struct casereader *reader, void *r_)
1730 {
1731   struct sfm_reader *r = r_;
1732   struct ccase *volatile c;
1733   int i;
1734
1735   if (r->error)
1736     return NULL;
1737
1738   c = case_create (r->proto);
1739   if (setjmp (r->bail_out))
1740     {
1741       casereader_force_error (reader);
1742       case_unref (c);
1743       return NULL;
1744     }
1745
1746   for (i = 0; i < r->sfm_var_cnt; i++)
1747     {
1748       struct sfm_var *sv = &r->sfm_vars[i];
1749       union value *v = case_data_rw_idx (c, sv->case_index);
1750
1751       if (sv->var_width == 0)
1752         {
1753           if (!read_case_number (r, &v->f))
1754             goto eof;
1755         }
1756       else
1757         {
1758           uint8_t *s = value_str_rw (v, sv->var_width);
1759           if (!read_case_string (r, s + sv->offset, sv->segment_width))
1760             goto eof;
1761           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
1762             partial_record (r);
1763         }
1764     }
1765   return c;
1766
1767 eof:
1768   case_unref (c);
1769   if (i != 0)
1770     partial_record (r);
1771   if (r->case_cnt != -1)
1772     read_error (reader, r);
1773   return NULL;
1774 }
1775
1776 /* Issues an error that R ends in a partial record. */
1777 static void
1778 partial_record (struct sfm_reader *r)
1779 {
1780   sys_error (r, _("File ends in partial case."));
1781 }
1782
1783 /* Issues an error that an unspecified error occurred SFM, and
1784    marks R tainted. */
1785 static void
1786 read_error (struct casereader *r, const struct sfm_reader *sfm)
1787 {
1788   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
1789   casereader_force_error (r);
1790 }
1791
1792 /* Reads a number from R and stores its value in *D.
1793    If R is compressed, reads a compressed number;
1794    otherwise, reads a number in the regular way.
1795    Returns true if successful, false if end of file is
1796    reached immediately. */
1797 static bool
1798 read_case_number (struct sfm_reader *r, double *d)
1799 {
1800   if (!r->compressed)
1801     {
1802       uint8_t number[8];
1803       if (!try_read_bytes (r, number, sizeof number))
1804         return false;
1805       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
1806       return true;
1807     }
1808   else
1809     return read_compressed_number (r, d);
1810 }
1811
1812 /* Reads LENGTH string bytes from R into S.
1813    Always reads a multiple of 8 bytes; if LENGTH is not a
1814    multiple of 8, then extra bytes are read and discarded without
1815    being written to S.
1816    Reads compressed strings if S is compressed.
1817    Returns true if successful, false if end of file is
1818    reached immediately. */
1819 static bool
1820 read_case_string (struct sfm_reader *r, uint8_t *s, size_t length)
1821 {
1822   size_t whole = ROUND_DOWN (length, 8);
1823   size_t partial = length % 8;
1824
1825   if (whole)
1826     {
1827       if (!read_whole_strings (r, s, whole))
1828         return false;
1829     }
1830
1831   if (partial)
1832     {
1833       uint8_t bounce[8];
1834       if (!read_whole_strings (r, bounce, sizeof bounce))
1835         {
1836           if (whole)
1837             partial_record (r);
1838           return false;
1839         }
1840       memcpy (s + whole, bounce, partial);
1841     }
1842
1843   return true;
1844 }
1845
1846 /* Reads and returns the next compression opcode from R. */
1847 static int
1848 read_opcode (struct sfm_reader *r)
1849 {
1850   assert (r->compressed);
1851   for (;;)
1852     {
1853       int opcode;
1854       if (r->opcode_idx >= sizeof r->opcodes)
1855         {
1856           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
1857             return -1;
1858           r->opcode_idx = 0;
1859         }
1860       opcode = r->opcodes[r->opcode_idx++];
1861
1862       if (opcode != 0)
1863         return opcode;
1864     }
1865 }
1866
1867 /* Reads a compressed number from R and stores its value in D.
1868    Returns true if successful, false if end of file is
1869    reached immediately. */
1870 static bool
1871 read_compressed_number (struct sfm_reader *r, double *d)
1872 {
1873   int opcode = read_opcode (r);
1874   switch (opcode)
1875     {
1876     case -1:
1877     case 252:
1878       return false;
1879
1880     case 253:
1881       *d = read_float (r);
1882       break;
1883
1884     case 254:
1885       float_convert (r->float_format, "        ", FLOAT_NATIVE_DOUBLE, d);
1886       if (!r->corruption_warning)
1887         {
1888           r->corruption_warning = true;
1889           sys_warn (r, _("Possible compressed data corruption: "
1890                          "compressed spaces appear in numeric field."));
1891         }
1892       break;
1893
1894     case 255:
1895       *d = SYSMIS;
1896       break;
1897
1898     default:
1899       *d = opcode - r->bias;
1900       break;
1901     }
1902
1903   return true;
1904 }
1905
1906 /* Reads a compressed 8-byte string segment from R and stores it
1907    in DST.
1908    Returns true if successful, false if end of file is
1909    reached immediately. */
1910 static bool
1911 read_compressed_string (struct sfm_reader *r, uint8_t *dst)
1912 {
1913   int opcode = read_opcode (r);
1914   switch (opcode)
1915     {
1916     case -1:
1917     case 252:
1918       return false;
1919
1920     case 253:
1921       read_bytes (r, dst, 8);
1922       break;
1923
1924     case 254:
1925       memset (dst, ' ', 8);
1926       break;
1927
1928     default:
1929       {
1930         double value = opcode - r->bias;
1931         float_convert (FLOAT_NATIVE_DOUBLE, &value, r->float_format, dst);
1932         if (value == 0.0)
1933           {
1934             /* This has actually been seen "in the wild".  The submitter of the
1935                file that showed that the contents decoded as spaces, but they
1936                were at the end of the field so it's possible that the null
1937                bytes just acted as null terminators. */
1938           }
1939         else if (!r->corruption_warning)
1940           {
1941             r->corruption_warning = true;
1942             sys_warn (r, _("Possible compressed data corruption: "
1943                            "string contains compressed integer (opcode %d)"),
1944                       opcode);
1945           }
1946       }
1947       break;
1948     }
1949
1950   return true;
1951 }
1952
1953 /* Reads LENGTH string bytes from R into S.
1954    LENGTH must be a multiple of 8.
1955    Reads compressed strings if S is compressed.
1956    Returns true if successful, false if end of file is
1957    reached immediately. */
1958 static bool
1959 read_whole_strings (struct sfm_reader *r, uint8_t *s, size_t length)
1960 {
1961   assert (length % 8 == 0);
1962   if (!r->compressed)
1963     return try_read_bytes (r, s, length);
1964   else
1965     {
1966       size_t ofs;
1967       for (ofs = 0; ofs < length; ofs += 8)
1968         if (!read_compressed_string (r, s + ofs))
1969           {
1970             if (ofs != 0)
1971               partial_record (r);
1972             return false;
1973           }
1974       return true;
1975     }
1976 }
1977
1978 /* Skips LENGTH string bytes from R.
1979    LENGTH must be a multiple of 8.
1980    (LENGTH is also limited to 1024, but that's only because the
1981    current caller never needs more than that many bytes.)
1982    Returns true if successful, false if end of file is
1983    reached immediately. */
1984 static bool
1985 skip_whole_strings (struct sfm_reader *r, size_t length)
1986 {
1987   uint8_t buffer[1024];
1988   assert (length < sizeof buffer);
1989   return read_whole_strings (r, buffer, length);
1990 }
1991 \f
1992 /* Creates and returns a table that can be used for translating a value
1993    index into a case to a "struct variable *" for DICT.  Multiple
1994    system file fields reference variables this way.
1995
1996    This table must be created before processing the very long
1997    string extension record, because that record causes some
1998    values to be deleted from the case and the dictionary to be
1999    compacted. */
2000 static struct variable **
2001 make_var_by_value_idx (struct sfm_reader *r, struct dictionary *dict)
2002 {
2003   struct variable **var_by_value_idx;
2004   int value_idx = 0;
2005   int i;
2006
2007   var_by_value_idx = pool_nmalloc (r->pool,
2008                                    r->oct_cnt, sizeof *var_by_value_idx);
2009   for (i = 0; i < dict_get_var_cnt (dict); i++)
2010     {
2011       struct variable *v = dict_get_var (dict, i);
2012       int nv = var_is_numeric (v) ? 1 : DIV_RND_UP (var_get_width (v), 8);
2013       int j;
2014
2015       var_by_value_idx[value_idx++] = v;
2016       for (j = 1; j < nv; j++)
2017         var_by_value_idx[value_idx++] = NULL;
2018     }
2019   assert (value_idx == r->oct_cnt);
2020
2021   return var_by_value_idx;
2022 }
2023
2024 /* Returns the "struct variable" corresponding to the given
2025    1-basd VALUE_IDX in VAR_BY_VALUE_IDX.  Verifies that the index
2026    is valid. */
2027 static struct variable *
2028 lookup_var_by_value_idx (struct sfm_reader *r,
2029                          struct variable **var_by_value_idx, int value_idx)
2030 {
2031   struct variable *var;
2032
2033   if (value_idx < 1 || value_idx > r->oct_cnt)
2034     sys_error (r, _("Variable index %d not in valid range 1...%d."),
2035                value_idx, r->oct_cnt);
2036
2037   var = var_by_value_idx[value_idx - 1];
2038   if (var == NULL)
2039     sys_error (r, _("Variable index %d refers to long string "
2040                     "continuation."),
2041                value_idx);
2042
2043   return var;
2044 }
2045
2046 /* Returns the variable in D with the given SHORT_NAME,
2047    or a null pointer if there is none. */
2048 static struct variable *
2049 lookup_var_by_short_name (struct dictionary *d, const char *short_name)
2050 {
2051   struct variable *var;
2052   size_t var_cnt;
2053   size_t i;
2054
2055   /* First try looking up by full name.  This often succeeds. */
2056   var = dict_lookup_var (d, short_name);
2057   if (var != NULL && !strcasecmp (var_get_short_name (var, 0), short_name))
2058     return var;
2059
2060   /* Iterate through the whole dictionary as a fallback. */
2061   var_cnt = dict_get_var_cnt (d);
2062   for (i = 0; i < var_cnt; i++)
2063     {
2064       var = dict_get_var (d, i);
2065       if (!strcasecmp (var_get_short_name (var, 0), short_name))
2066         return var;
2067     }
2068
2069   return NULL;
2070 }
2071 \f
2072 /* Helpers for reading records that contain structured text
2073    strings. */
2074
2075 /* Maximum number of warnings to issue for a single text
2076    record. */
2077 #define MAX_TEXT_WARNINGS 5
2078
2079 /* State. */
2080 struct text_record
2081   {
2082     struct substring buffer;    /* Record contents. */
2083     size_t pos;                 /* Current position in buffer. */
2084     int n_warnings;             /* Number of warnings issued or suppressed. */
2085   };
2086
2087 /* Reads SIZE bytes into a text record for R,
2088    and returns the new text record. */
2089 static struct text_record *
2090 open_text_record (struct sfm_reader *r, size_t size)
2091 {
2092   struct text_record *text = pool_alloc (r->pool, sizeof *text);
2093   char *buffer = pool_malloc (r->pool, size + 1);
2094   read_bytes (r, buffer, size);
2095   text->buffer = ss_buffer (buffer, size);
2096   text->pos = 0;
2097   text->n_warnings = 0;
2098   return text;
2099 }
2100
2101 /* Closes TEXT, frees its storage, and issues a final warning
2102    about suppressed warnings if necesary. */
2103 static void
2104 close_text_record (struct sfm_reader *r, struct text_record *text)
2105 {
2106   if (text->n_warnings > MAX_TEXT_WARNINGS)
2107     sys_warn (r, _("Suppressed %d additional related warnings."),
2108               text->n_warnings - MAX_TEXT_WARNINGS);
2109   pool_free (r->pool, ss_data (text->buffer));
2110 }
2111
2112 /* Reads a variable=value pair from TEXT.
2113    Looks up the variable in DICT and stores it into *VAR.
2114    Stores a null-terminated value into *VALUE. */
2115 static bool
2116 read_variable_to_value_pair (struct sfm_reader *r, struct dictionary *dict,
2117                              struct text_record *text,
2118                              struct variable **var, char **value)
2119 {
2120   for (;;)
2121     {
2122       if (!text_read_short_name (r, dict, text, ss_cstr ("="), var))
2123         return false;
2124
2125       *value = text_get_token (text, ss_buffer ("\t\0", 2), NULL);
2126       if (*value == NULL)
2127         return false;
2128
2129       text->pos += ss_span (ss_substr (text->buffer, text->pos, SIZE_MAX),
2130                             ss_buffer ("\t\0", 2));
2131
2132       if (*var != NULL)
2133         return true;
2134     }
2135 }
2136
2137 static bool
2138 text_read_variable_name (struct sfm_reader *r, struct dictionary *dict,
2139                          struct text_record *text, struct substring delimiters,
2140                          struct variable **var)
2141 {
2142   char *name;
2143
2144   name = text_get_token (text, delimiters, NULL);
2145   if (name == NULL)
2146     return false;
2147
2148   *var = dict_lookup_var (dict, name);
2149   if (*var != NULL)
2150     return true;
2151
2152   text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2153              name);
2154   return false;
2155 }
2156
2157
2158 static bool
2159 text_read_short_name (struct sfm_reader *r, struct dictionary *dict,
2160                       struct text_record *text, struct substring delimiters,
2161                       struct variable **var)
2162 {
2163   char *short_name = text_get_token (text, delimiters, NULL);
2164   if (short_name == NULL)
2165     return false;
2166
2167   *var = lookup_var_by_short_name (dict, short_name);
2168   if (*var == NULL)
2169     text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2170                short_name);
2171   return true;
2172 }
2173
2174 /* Displays a warning for the current file position, limiting the
2175    number to MAX_TEXT_WARNINGS for TEXT. */
2176 static void
2177 text_warn (struct sfm_reader *r, struct text_record *text,
2178            const char *format, ...)
2179 {
2180   if (text->n_warnings++ < MAX_TEXT_WARNINGS)
2181     {
2182       va_list args;
2183
2184       va_start (args, format);
2185       sys_msg (r, MW, format, args);
2186       va_end (args);
2187     }
2188 }
2189
2190 static char *
2191 text_get_token (struct text_record *text, struct substring delimiters,
2192                 char *delimiter)
2193 {
2194   struct substring token;
2195   char *end;
2196
2197   if (!ss_tokenize (text->buffer, delimiters, &text->pos, &token))
2198     return NULL;
2199
2200   end = &ss_data (token)[ss_length (token)];
2201   if (delimiter != NULL)
2202     *delimiter = *end;
2203   *end = '\0';
2204   return ss_data (token);
2205 }
2206
2207 /* Reads a integer value expressed in decimal, then a space, then a string that
2208    consists of exactly as many bytes as specified by the integer, then a space,
2209    from TEXT.  Returns the string, null-terminated, as a subset of TEXT's
2210    buffer (so the caller should not free the string). */
2211 static const char *
2212 text_parse_counted_string (struct sfm_reader *r, struct text_record *text)
2213 {
2214   size_t start;
2215   size_t n;
2216   char *s;
2217
2218   start = text->pos;
2219   n = 0;
2220   for (;;)
2221     {
2222       int c = text->buffer.string[text->pos];
2223       if (c < '0' || c > '9')
2224         break;
2225       n = (n * 10) + (c - '0');
2226       text->pos++;
2227     }
2228   if (start == text->pos)
2229     {
2230       sys_warn (r, _("Expecting digit at offset %zu in MRSETS record."),
2231                  text->pos);
2232       return NULL;
2233     }
2234
2235   if (!text_match (text, ' '))
2236     {
2237       sys_warn (r, _("Expecting space at offset %zu in MRSETS record."),
2238                 text->pos);
2239       return NULL;
2240     }
2241
2242   if (text->pos + n > text->buffer.length)
2243     {
2244       sys_warn (r, _("%zu-byte string starting at offset %zu "
2245                      "exceeds record length %zu."),
2246                 n, text->pos, text->buffer.length);
2247       return NULL;
2248     }
2249
2250   s = &text->buffer.string[text->pos];
2251   if (s[n] != ' ')
2252     {
2253       sys_warn (r,
2254                 _("Expecting space at offset %zu following %zu-byte string."),
2255                 text->pos + n, n);
2256       return NULL;
2257     }
2258   s[n] = '\0';
2259   text->pos += n + 1;
2260   return s;
2261 }
2262
2263 static bool
2264 text_match (struct text_record *text, char c)
2265 {
2266   if (text->buffer.string[text->pos] == c)
2267     {
2268       text->pos++;
2269       return true;
2270     }
2271   else
2272     return false;
2273 }
2274
2275 /* Returns the current byte offset inside the TEXT's string. */
2276 static size_t
2277 text_pos (const struct text_record *text)
2278 {
2279   return text->pos;
2280 }
2281 \f
2282 /* Messages. */
2283
2284 /* Displays a corruption message. */
2285 static void
2286 sys_msg (struct sfm_reader *r, int class, const char *format, va_list args)
2287 {
2288   struct msg m;
2289   struct string text;
2290
2291   ds_init_empty (&text);
2292   ds_put_format (&text, "\"%s\" near offset 0x%llx: ",
2293                  fh_get_file_name (r->fh), (long long int) ftello (r->file));
2294   ds_put_vformat (&text, format, args);
2295
2296   m.category = msg_class_to_category (class);
2297   m.severity = msg_class_to_severity (class);
2298   m.where.file_name = NULL;
2299   m.where.line_number = 0;
2300   m.text = ds_cstr (&text);
2301
2302   msg_emit (&m);
2303 }
2304
2305 /* Displays a warning for the current file position. */
2306 static void
2307 sys_warn (struct sfm_reader *r, const char *format, ...)
2308 {
2309   va_list args;
2310
2311   va_start (args, format);
2312   sys_msg (r, MW, format, args);
2313   va_end (args);
2314 }
2315
2316 /* Displays an error for the current file position,
2317    marks it as in an error state,
2318    and aborts reading it using longjmp. */
2319 static void
2320 sys_error (struct sfm_reader *r, const char *format, ...)
2321 {
2322   va_list args;
2323
2324   va_start (args, format);
2325   sys_msg (r, ME, format, args);
2326   va_end (args);
2327
2328   r->error = true;
2329   longjmp (r->bail_out, 1);
2330 }
2331 \f
2332 /* Reads BYTE_CNT bytes into BUF.
2333    Returns true if exactly BYTE_CNT bytes are successfully read.
2334    Aborts if an I/O error or a partial read occurs.
2335    If EOF_IS_OK, then an immediate end-of-file causes false to be
2336    returned; otherwise, immediate end-of-file causes an abort
2337    too. */
2338 static inline bool
2339 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
2340                    void *buf, size_t byte_cnt)
2341 {
2342   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
2343   if (bytes_read == byte_cnt)
2344     return true;
2345   else if (ferror (r->file))
2346     sys_error (r, _("System error: %s."), strerror (errno));
2347   else if (!eof_is_ok || bytes_read != 0)
2348     sys_error (r, _("Unexpected end of file."));
2349   else
2350     return false;
2351 }
2352
2353 /* Reads BYTE_CNT into BUF.
2354    Aborts upon I/O error or if end-of-file is encountered. */
2355 static void
2356 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2357 {
2358   read_bytes_internal (r, false, buf, byte_cnt);
2359 }
2360
2361 /* Reads BYTE_CNT bytes into BUF.
2362    Returns true if exactly BYTE_CNT bytes are successfully read.
2363    Returns false if an immediate end-of-file is encountered.
2364    Aborts if an I/O error or a partial read occurs. */
2365 static bool
2366 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2367 {
2368   return read_bytes_internal (r, true, buf, byte_cnt);
2369 }
2370
2371 /* Reads a 32-bit signed integer from R and returns its value in
2372    host format. */
2373 static int
2374 read_int (struct sfm_reader *r)
2375 {
2376   uint8_t integer[4];
2377   read_bytes (r, integer, sizeof integer);
2378   return integer_get (r->integer_format, integer, sizeof integer);
2379 }
2380
2381 /* Reads a 64-bit floating-point number from R and returns its
2382    value in host format. */
2383 static double
2384 read_float (struct sfm_reader *r)
2385 {
2386   uint8_t number[8];
2387   read_bytes (r, number, sizeof number);
2388   return float_get_double (r->float_format, number);
2389 }
2390
2391 /* Reads exactly SIZE - 1 bytes into BUFFER
2392    and stores a null byte into BUFFER[SIZE - 1]. */
2393 static void
2394 read_string (struct sfm_reader *r, char *buffer, size_t size)
2395 {
2396   assert (size > 0);
2397   read_bytes (r, buffer, size - 1);
2398   buffer[size - 1] = '\0';
2399 }
2400
2401 /* Skips BYTES bytes forward in R. */
2402 static void
2403 skip_bytes (struct sfm_reader *r, size_t bytes)
2404 {
2405   while (bytes > 0)
2406     {
2407       char buffer[1024];
2408       size_t chunk = MIN (sizeof buffer, bytes);
2409       read_bytes (r, buffer, chunk);
2410       bytes -= chunk;
2411     }
2412 }
2413 \f
2414 static const struct casereader_class sys_file_casereader_class =
2415   {
2416     sys_file_casereader_read,
2417     sys_file_casereader_destroy,
2418     NULL,
2419     NULL,
2420   };