src/data/sys-file-reader.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-9, 2000, 2006, 2007, 2009, 2010, 2011 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 "
 893                      "a copy of this file, and the syntax which created it "
 894                      "to %s."),
 895                 subtype, PACKAGE_BUGREPORT);
 896       break;
 897     }
 898
 899   skip_bytes (r, bytes);
 900 }
 901
 902 /* Read record type 7, subtype 3. */
 903 static void
 904 read_machine_integer_info (struct sfm_reader *r, size_t size, size_t count,
 905                            struct sfm_read_info *info,
 906                            struct dictionary *dict)
 907 {
 908   int version_major = read_int (r);
 909   int version_minor = read_int (r);
 910   int version_revision = read_int (r);
 911   int machine_code UNUSED = read_int (r);
 912   int float_representation = read_int (r);
 913   int compression_code UNUSED = read_int (r);
 914   int integer_representation = read_int (r);
 915   int character_code = read_int (r);
 916
 917   int expected_float_format;
 918   int expected_integer_format;
 919
 920   if (size != 4 || count != 8)
 921     sys_error (r, _("Bad size (%zu) or count (%zu) field on record type 7, "
 922                     "subtype 3."),
 923                 size, count);
 924
 925   /* Save version info. */
 926   info->version_major = version_major;
 927   info->version_minor = version_minor;
 928   info->version_revision = version_revision;
 929
 930   /* Check floating point format. */
 931   if (r->float_format == FLOAT_IEEE_DOUBLE_BE
 932       || r->float_format == FLOAT_IEEE_DOUBLE_LE)
 933     expected_float_format = 1;
 934   else if (r->float_format == FLOAT_Z_LONG)
 935     expected_float_format = 2;
 936   else if (r->float_format == FLOAT_VAX_G || r->float_format == FLOAT_VAX_D)
 937     expected_float_format = 3;
 938   else
 939     NOT_REACHED ();
 940   if (float_representation != expected_float_format)
 941     sys_error (r, _("Floating-point representation indicated by "
 942                     "system file (%d) differs from expected (%d)."),
 943                r->float_format, expected_float_format);
 944
 945   /* Check integer format. */
 946   if (r->integer_format == INTEGER_MSB_FIRST)
 947     expected_integer_format = 1;
 948   else if (r->integer_format == INTEGER_LSB_FIRST)
 949     expected_integer_format = 2;
 950   else
 951     NOT_REACHED ();
 952   if (integer_representation != expected_integer_format)
 953     {
 954       static const char *const endian[] = {N_("Little Endian"), N_("Big Endian")};
 955       sys_warn (r, _("Integer format indicated by system file (%s) "
 956                      "differs from expected (%s)."),
 957                 gettext (endian[integer_representation == 1]),
 958                 gettext (endian[expected_integer_format == 1]));
 959     }
 960
 961
 962   /*
 963     Record 7 (20) provides a much more reliable way of
 964     setting the encoding.
 965     The character_code is used as a fallback only.
 966   */
 967   if ( NULL == dict_get_encoding (dict))
 968     {
 969       switch (character_code)
 970         {
 971         case 1:
 972           dict_set_encoding (dict, "EBCDIC-US");
 973           break;
 974         case 2:
 975         case 3:
 976           /* These ostensibly mean "7-bit ASCII" and "8-bit ASCII"[sic]
 977              respectively.   However, there are known to be many files
 978              in the wild with character code 2, yet have data which are
 979              clearly not ascii.
 980              Therefore we ignore these values.
 981           */
 982           return;
 983         case 4:
 984           dict_set_encoding (dict, "MS_KANJI");
 985           break;
 986         case 65000:
 987           dict_set_encoding (dict, "UTF-7");
 988           break;
 989         case 65001:
 990           dict_set_encoding (dict, "UTF-8");
 991           break;
 992         default:
 993           {
 994             char enc[100];
 995             snprintf (enc, 100, "CP%d", character_code);
 996             dict_set_encoding (dict, enc);
 997           }
 998           break;
 999         };
1000     }
1001 }
1002
1003 /* Read record type 7, subtype 4. */
1004 static void
1005 read_machine_float_info (struct sfm_reader *r, size_t size, size_t count)
1006 {
1007   double sysmis = read_float (r);
1008   double highest = read_float (r);
1009   double lowest = read_float (r);
1010
1011   if (size != 8 || count != 3)
1012     sys_error (r, _("Bad size (%zu) or count (%zu) on extension 4."),
1013                size, count);
1014
1015   if (sysmis != SYSMIS)
1016     sys_warn (r, _("File specifies unexpected value %g as %s."),
1017               sysmis, "SYSMIS");
1018
1019   if (highest != HIGHEST)
1020     sys_warn (r, _("File specifies unexpected value %g as %s."),
1021               highest, "HIGHEST");
1022
1023   if (lowest != LOWEST)
1024     sys_warn (r, _("File specifies unexpected value %g as %s."),
1025               lowest, "LOWEST");
1026 }
1027
1028 /* Read record type 7, subtype 7 or 19. */
1029 static void
1030 read_mrsets (struct sfm_reader *r, size_t size, size_t count,
1031              struct dictionary *dict)
1032 {
1033   struct text_record *text;
1034   struct mrset *mrset;
1035
1036   text = open_text_record (r, size * count);
1037   for (;;)
1038     {
1039       const char *name, *label, *counted;
1040       struct stringi_set var_names;
1041       size_t allocated_vars;
1042       char delimiter;
1043       int width;
1044
1045       mrset = xzalloc (sizeof *mrset);
1046
1047       name = text_get_token (text, ss_cstr ("="), NULL);
1048       if (name == NULL)
1049         break;
1050       mrset->name = xstrdup (name);
1051
1052       if (mrset->name[0] != '$')
1053         {
1054           sys_warn (r, _("`%s' does not begin with `$' at offset %zu "
1055                          "in MRSETS record."), mrset->name, text_pos (text));
1056           break;
1057         }
1058
1059       if (text_match (text, 'C'))
1060         {
1061           mrset->type = MRSET_MC;
1062           if (!text_match (text, ' '))
1063             {
1064               sys_warn (r, _("Missing space following `%c' at offset %zu "
1065                              "in MRSETS record."), 'C', text_pos (text));
1066               break;
1067             }
1068         }
1069       else if (text_match (text, 'D'))
1070         {
1071           mrset->type = MRSET_MD;
1072           mrset->cat_source = MRSET_VARLABELS;
1073         }
1074       else if (text_match (text, 'E'))
1075         {
1076           char *number;
1077
1078           mrset->type = MRSET_MD;
1079           mrset->cat_source = MRSET_COUNTEDVALUES;
1080           if (!text_match (text, ' '))
1081             {
1082               sys_warn (r, _("Missing space following `%c' at offset %zu "
1083                              "in MRSETS record."), 'E',  text_pos (text));
1084               break;
1085             }
1086
1087           number = text_get_token (text, ss_cstr (" "), NULL);
1088           if (!strcmp (number, "11"))
1089             mrset->label_from_var_label = true;
1090           else if (strcmp (number, "1"))
1091             sys_warn (r, _("Unexpected label source value `%s' "
1092                            "following `E' at offset %zu in MRSETS record."),
1093                       number, text_pos (text));
1094         }
1095       else
1096         {
1097           sys_warn (r, _("Missing `C', `D', or `E' at offset %zu "
1098                          "in MRSETS record."),
1099                     text_pos (text));
1100           break;
1101         }
1102
1103       if (mrset->type == MRSET_MD)
1104         {
1105           counted = text_parse_counted_string (r, text);
1106           if (counted == NULL)
1107             break;
1108         }
1109
1110       label = text_parse_counted_string (r, text);
1111       if (label == NULL)
1112         break;
1113       mrset->label = label[0] != '\0' ? xstrdup (label) : NULL;
1114
1115       stringi_set_init (&var_names);
1116       allocated_vars = 0;
1117       width = INT_MAX;
1118       do
1119         {
1120           struct variable *var;
1121           const char *var_name;
1122
1123           var_name = text_get_token (text, ss_cstr (" \n"), &delimiter);
1124           if (var_name == NULL)
1125             {
1126               sys_warn (r, _("Missing new-line parsing variable names "
1127                              "at offset %zu in MRSETS record."),
1128                         text_pos (text));
1129               break;
1130             }
1131
1132           var = lookup_var_by_short_name (dict, var_name);
1133           if (var == NULL)
1134             continue;
1135           if (!stringi_set_insert (&var_names, var_name))
1136             {
1137               sys_warn (r, _("Duplicate variable name %s "
1138                              "at offset %zu in MRSETS record."),
1139                         var_name, text_pos (text));
1140               continue;
1141             }
1142
1143           if (mrset->label == NULL && mrset->label_from_var_label
1144               && var_has_label (var))
1145             mrset->label = xstrdup (var_get_label (var));
1146
1147           if (mrset->n_vars
1148               && var_get_type (var) != var_get_type (mrset->vars[0]))
1149             {
1150               sys_warn (r, _("MRSET %s contains both string and "
1151                              "numeric variables."), name);
1152               continue;
1153             }
1154           width = MIN (width, var_get_width (var));
1155
1156           if (mrset->n_vars >= allocated_vars)
1157             mrset->vars = x2nrealloc (mrset->vars, &allocated_vars,
1158                                       sizeof *mrset->vars);
1159           mrset->vars[mrset->n_vars++] = var;
1160         }
1161       while (delimiter != '\n');
1162
1163       if (mrset->n_vars < 2)
1164         {
1165           sys_warn (r, _("MRSET %s has only %zu variables."), mrset->name,
1166                     mrset->n_vars);
1167           mrset_destroy (mrset);
1168           continue;
1169         }
1170
1171       if (mrset->type == MRSET_MD)
1172         {
1173           mrset->width = width;
1174           value_init (&mrset->counted, width);
1175           if (width == 0)
1176             mrset->counted.f = strtod (counted, NULL);
1177           else
1178             value_copy_str_rpad (&mrset->counted, width,
1179                                  (const uint8_t *) counted, ' ');
1180         }
1181
1182       dict_add_mrset (dict, mrset);
1183       mrset = NULL;
1184       stringi_set_destroy (&var_names);
1185     }
1186   mrset_destroy (mrset);
1187   close_text_record (r, text);
1188 }
1189
1190 /* Read record type 7, subtype 11, which specifies how variables
1191    should be displayed in GUI environments. */
1192 static void
1193 read_display_parameters (struct sfm_reader *r, size_t size, size_t count,
1194                          struct dictionary *dict)
1195 {
1196   size_t n_vars;
1197   bool includes_width;
1198   bool warned = false;
1199   size_t i;
1200
1201   if (size != 4)
1202     {
1203       sys_warn (r, _("Bad size %zu on extension 11."), size);
1204       skip_bytes (r, size * count);
1205       return;
1206     }
1207
1208   n_vars = dict_get_var_cnt (dict);
1209   if (count == 3 * n_vars)
1210     includes_width = true;
1211   else if (count == 2 * n_vars)
1212     includes_width = false;
1213   else
1214     {
1215       sys_warn (r, _("Extension 11 has bad count %zu (for %zu variables)."),
1216                 count, n_vars);
1217       skip_bytes (r, size * count);
1218       return;
1219     }
1220
1221   for (i = 0; i < n_vars; ++i)
1222     {
1223       struct variable *v = dict_get_var (dict, i);
1224       int measure = read_int (r);
1225       int width = includes_width ? read_int (r) : 0;
1226       int align = read_int (r);
1227
1228       /* SPSS 14 sometimes seems to set string variables' measure
1229          to zero. */
1230       if (0 == measure && var_is_alpha (v))
1231         measure = 1;
1232
1233       if (measure < 1 || measure > 3 || align < 0 || align > 2)
1234         {
1235           if (!warned)
1236             sys_warn (r, _("Invalid variable display parameters "
1237                            "for variable %zu (%s).  "
1238                            "Default parameters substituted."),
1239                       i, var_get_name (v));
1240           warned = true;
1241           continue;
1242         }
1243
1244       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
1245                            : measure == 2 ? MEASURE_ORDINAL
1246                            : MEASURE_SCALE));
1247       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
1248                              : align == 1 ? ALIGN_RIGHT
1249                              : ALIGN_CENTRE));
1250
1251       /* Older versions (SPSS 9.0) sometimes set the display
1252          width to zero.  This causes confusion in the GUI, so
1253          only set the width if it is nonzero. */
1254       if (width > 0)
1255         var_set_display_width (v, width);
1256     }
1257 }
1258
1259 /* Reads record type 7, subtype 13, which gives the long name
1260    that corresponds to each short name.  Modifies variable names
1261    in DICT accordingly.  */
1262 static void
1263 read_long_var_name_map (struct sfm_reader *r, size_t size, size_t count,
1264                         struct dictionary *dict)
1265 {
1266   struct text_record *text;
1267   struct variable *var;
1268   char *long_name;
1269
1270   text = open_text_record (r, size * count);
1271   while (read_variable_to_value_pair (r, dict, text, &var, &long_name))
1272     {
1273       char **short_names;
1274       size_t short_name_cnt;
1275       size_t i;
1276
1277       /* Validate long name. */
1278       if (!var_is_valid_name (long_name, false))
1279         {
1280           sys_warn (r, _("Long variable mapping from %s to invalid "
1281                          "variable name `%s'."),
1282                     var_get_name (var), long_name);
1283           continue;
1284         }
1285
1286       /* Identify any duplicates. */
1287       if (strcasecmp (var_get_short_name (var, 0), long_name)
1288           && dict_lookup_var (dict, long_name) != NULL)
1289         {
1290           sys_warn (r, _("Duplicate long variable name `%s' "
1291                          "within system file."), long_name);
1292           continue;
1293         }
1294
1295       /* Renaming a variable may clear its short names, but we
1296          want to retain them, so we save them and re-set them
1297          afterward. */
1298       short_name_cnt = var_get_short_name_cnt (var);
1299       short_names = xnmalloc (short_name_cnt, sizeof *short_names);
1300       for (i = 0; i < short_name_cnt; i++)
1301         {
1302           const char *s = var_get_short_name (var, i);
1303           short_names[i] = s != NULL ? xstrdup (s) : NULL;
1304         }
1305
1306       /* Set long name. */
1307       dict_rename_var (dict, var, long_name);
1308
1309       /* Restore short names. */
1310       for (i = 0; i < short_name_cnt; i++)
1311         {
1312           var_set_short_name (var, i, short_names[i]);
1313           free (short_names[i]);
1314         }
1315       free (short_names);
1316     }
1317   close_text_record (r, text);
1318   r->has_long_var_names = true;
1319 }
1320
1321 /* Reads record type 7, subtype 14, which gives the real length
1322    of each very long string.  Rearranges DICT accordingly. */
1323 static void
1324 read_long_string_map (struct sfm_reader *r, size_t size, size_t count,
1325                       struct dictionary *dict)
1326 {
1327   struct text_record *text;
1328   struct variable *var;
1329   char *length_s;
1330
1331   text = open_text_record (r, size * count);
1332   while (read_variable_to_value_pair (r, dict, text, &var, &length_s))
1333     {
1334       size_t idx = var_get_dict_index (var);
1335       long int length;
1336       int segment_cnt;
1337       int i;
1338
1339       /* Get length. */
1340       length = strtol (length_s, NULL, 10);
1341       if (length < 1 || length > MAX_STRING)
1342         {
1343           sys_warn (r, _("%s listed as string of invalid length %s "
1344                          "in very long string record."),
1345                     var_get_name (var), length_s);
1346           continue;
1347         }
1348
1349       /* Check segments. */
1350       segment_cnt = sfm_width_to_segments (length);
1351       if (segment_cnt == 1)
1352         {
1353           sys_warn (r, _("%s listed in very long string record with width %s, "
1354                          "which requires only one segment."),
1355                     var_get_name (var), length_s);
1356           continue;
1357         }
1358       if (idx + segment_cnt > dict_get_var_cnt (dict))
1359         sys_error (r, _("Very long string %s overflows dictionary."),
1360                    var_get_name (var));
1361
1362       /* Get the short names from the segments and check their
1363          lengths. */
1364       for (i = 0; i < segment_cnt; i++)
1365         {
1366           struct variable *seg = dict_get_var (dict, idx + i);
1367           int alloc_width = sfm_segment_alloc_width (length, i);
1368           int width = var_get_width (seg);
1369
1370           if (i > 0)
1371             var_set_short_name (var, i, var_get_short_name (seg, 0));
1372           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
1373             sys_error (r, _("Very long string with width %ld has segment %d "
1374                             "of width %d (expected %d)."),
1375                        length, i, width, alloc_width);
1376         }
1377       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1378       var_set_width (var, length);
1379     }
1380   close_text_record (r, text);
1381   dict_compact_values (dict);
1382 }
1383
1384 /* Reads value labels from sysfile H and inserts them into the
1385    associated dictionary. */
1386 static void
1387 read_value_labels (struct sfm_reader *r,
1388                    struct dictionary *dict, struct variable **var_by_value_idx)
1389 {
1390   struct pool *subpool;
1391
1392   struct label
1393     {
1394       uint8_t raw_value[8];        /* Value as uninterpreted bytes. */
1395       union value value;        /* Value. */
1396       char *label;              /* Null-terminated label string. */
1397     };
1398
1399   struct label *labels = NULL;
1400   int label_cnt;                /* Number of labels. */
1401
1402   struct variable **var = NULL; /* Associated variables. */
1403   int var_cnt;                  /* Number of associated variables. */
1404   int max_width;                /* Maximum width of string variables. */
1405
1406   int i;
1407
1408   subpool = pool_create_subpool (r->pool);
1409
1410   /* Read the type 3 record and record its contents.  We can't do
1411      much with the data yet because we don't know whether it is
1412      of numeric or string type. */
1413
1414   /* Read number of labels. */
1415   label_cnt = read_int (r);
1416
1417   if (size_overflow_p (xtimes (label_cnt, sizeof *labels)))
1418     {
1419       sys_warn (r, _("Invalid number of labels: %d.  Ignoring labels."),
1420                 label_cnt);
1421       label_cnt = 0;
1422     }
1423
1424   /* Read each value/label tuple into labels[]. */
1425   labels = pool_nalloc (subpool, label_cnt, sizeof *labels);
1426   for (i = 0; i < label_cnt; i++)
1427     {
1428       struct label *label = labels + i;
1429       unsigned char label_len;
1430       size_t padded_len;
1431
1432       /* Read value. */
1433       read_bytes (r, label->raw_value, sizeof label->raw_value);
1434
1435       /* Read label length. */
1436       read_bytes (r, &label_len, sizeof label_len);
1437       padded_len = ROUND_UP (label_len + 1, 8);
1438
1439       /* Read label, padding. */
1440       label->label = pool_alloc (subpool, padded_len + 1);
1441       read_bytes (r, label->label, padded_len - 1);
1442       label->label[label_len] = 0;
1443     }
1444
1445   /* Now, read the type 4 record that has the list of variables
1446      to which the value labels are to be applied. */
1447
1448   /* Read record type of type 4 record. */
1449   if (read_int (r) != 4)
1450     sys_error (r, _("Variable index record (type 4) does not immediately "
1451                     "follow value label record (type 3) as it should."));
1452
1453   /* Read number of variables associated with value label from type 4
1454      record. */
1455   var_cnt = read_int (r);
1456   if (var_cnt < 1 || var_cnt > dict_get_var_cnt (dict))
1457     sys_error (r, _("Number of variables associated with a value label (%d) "
1458                     "is not between 1 and the number of variables (%zu)."),
1459                var_cnt, dict_get_var_cnt (dict));
1460
1461   /* Read the list of variables. */
1462   var = pool_nalloc (subpool, var_cnt, sizeof *var);
1463   max_width = 0;
1464   for (i = 0; i < var_cnt; i++)
1465     {
1466       var[i] = lookup_var_by_value_idx (r, var_by_value_idx, read_int (r));
1467       if (var_get_width (var[i]) > 8)
1468         sys_error (r, _("Value labels may not be added to long string "
1469                         "variables (e.g. %s) using records types 3 and 4."),
1470                    var_get_name (var[i]));
1471       max_width = MAX (max_width, var_get_width (var[i]));
1472     }
1473
1474   /* Type check the variables. */
1475   for (i = 1; i < var_cnt; i++)
1476     if (var_get_type (var[i]) != var_get_type (var[0]))
1477       sys_error (r, _("Variables associated with value label are not all of "
1478                       "identical type.  Variable %s is %s, but variable "
1479                       "%s is %s."),
1480                  var_get_name (var[0]),
1481                  var_is_numeric (var[0]) ? _("numeric") : _("string"),
1482                  var_get_name (var[i]),
1483                  var_is_numeric (var[i]) ? _("numeric") : _("string"));
1484
1485   /* Fill in labels[].value, now that we know the desired type. */
1486   for (i = 0; i < label_cnt; i++)
1487     {
1488       struct label *label = labels + i;
1489
1490       value_init_pool (subpool, &label->value, max_width);
1491       if (var_is_alpha (var[0]))
1492         u8_buf_copy_rpad (value_str_rw (&label->value, max_width), max_width,
1493                        label->raw_value, sizeof label->raw_value, ' ');
1494       else
1495         label->value.f = float_get_double (r->float_format, label->raw_value);
1496     }
1497
1498   /* Assign the `value_label's to each variable. */
1499   for (i = 0; i < var_cnt; i++)
1500     {
1501       struct variable *v = var[i];
1502       int j;
1503
1504       /* Add each label to the variable. */
1505       for (j = 0; j < label_cnt; j++)
1506         {
1507           struct label *label = &labels[j];
1508           if (!var_add_value_label (v, &label->value, label->label))
1509             {
1510               if (var_is_numeric (var[0]))
1511                 sys_warn (r, _("Duplicate value label for %g on %s."),
1512                           label->value.f, var_get_name (v));
1513               else
1514                 sys_warn (r, _("Duplicate value label for `%.*s' on %s."),
1515                           max_width, value_str (&label->value, max_width),
1516                           var_get_name (v));
1517             }
1518         }
1519     }
1520
1521   pool_destroy (subpool);
1522 }
1523
1524 /* Reads a set of custom attributes from TEXT into ATTRS.
1525    ATTRS may be a null pointer, in which case the attributes are
1526    read but discarded. */
1527 static void
1528 read_attributes (struct sfm_reader *r, struct text_record *text,
1529                  struct attrset *attrs)
1530 {
1531   do
1532     {
1533       struct attribute *attr;
1534       char *key;
1535       int index;
1536
1537       /* Parse the key. */
1538       key = text_get_token (text, ss_cstr ("("), NULL);
1539       if (key == NULL)
1540         return;
1541
1542       attr = attribute_create (key);
1543       for (index = 1; ; index++)
1544         {
1545           /* Parse the value. */
1546           char *value;
1547           size_t length;
1548
1549           value = text_get_token (text, ss_cstr ("\n"), NULL);
1550           if (value == NULL)
1551             {
1552               text_warn (r, text, _("Error parsing attribute value %s[%d]."),
1553                          key, index);
1554               break;
1555             }
1556
1557           length = strlen (value);
1558           if (length >= 2 && value[0] == '\'' && value[length - 1] == '\'')
1559             {
1560               value[length - 1] = '\0';
1561               attribute_add_value (attr, value + 1);
1562             }
1563           else
1564             {
1565               text_warn (r, text,
1566                          _("Attribute value %s[%d] is not quoted: %s."),
1567                          key, index, value);
1568               attribute_add_value (attr, value);
1569             }
1570
1571           /* Was this the last value for this attribute? */
1572           if (text_match (text, ')'))
1573             break;
1574         }
1575       if (attrs != NULL)
1576         attrset_add (attrs, attr);
1577       else
1578         attribute_destroy (attr);
1579     }
1580   while (!text_match (text, '/'));
1581 }
1582
1583 /* Reads record type 7, subtype 17, which lists custom
1584    attributes on the data file.  */
1585 static void
1586 read_data_file_attributes (struct sfm_reader *r,
1587                            size_t size, size_t count,
1588                            struct dictionary *dict)
1589 {
1590   struct text_record *text = open_text_record (r, size * count);
1591   read_attributes (r, text, dict_get_attributes (dict));
1592   close_text_record (r, text);
1593 }
1594
1595 static void
1596 skip_long_string_value_labels (struct sfm_reader *r, size_t n_labels)
1597 {
1598   size_t i;
1599
1600   for (i = 0; i < n_labels; i++)
1601     {
1602       size_t value_length, label_length;
1603
1604       value_length = read_int (r);
1605       skip_bytes (r, value_length);
1606       label_length = read_int (r);
1607       skip_bytes (r, label_length);
1608     }
1609 }
1610
1611 static void
1612 read_long_string_value_labels (struct sfm_reader *r,
1613                                size_t size, size_t count,
1614                                struct dictionary *d)
1615 {
1616   const off_t start = ftello (r->file);
1617   while (ftello (r->file) - start < size * count)
1618     {
1619       char var_name[VAR_NAME_LEN + 1];
1620       size_t n_labels, i;
1621       struct variable *v;
1622       union value value;
1623       int var_name_len;
1624       int width;
1625
1626       /* Read header. */
1627       var_name_len = read_int (r);
1628       if (var_name_len > VAR_NAME_LEN)
1629         sys_error (r, _("Variable name length in long string value label "
1630                         "record (%d) exceeds %d-byte limit."),
1631                    var_name_len, VAR_NAME_LEN);
1632       read_string (r, var_name, var_name_len + 1);
1633       width = read_int (r);
1634       n_labels = read_int (r);
1635
1636       v = dict_lookup_var (d, var_name);
1637       if (v == NULL)
1638         {
1639           sys_warn (r, _("Ignoring long string value record for "
1640                          "unknown variable %s."), var_name);
1641           skip_long_string_value_labels (r, n_labels);
1642           continue;
1643         }
1644       if (var_is_numeric (v))
1645         {
1646           sys_warn (r, _("Ignoring long string value record for "
1647                          "numeric variable %s."), var_name);
1648           skip_long_string_value_labels (r, n_labels);
1649           continue;
1650         }
1651       if (width != var_get_width (v))
1652         {
1653           sys_warn (r, _("Ignoring long string value record for variable %s "
1654                          "because the record's width (%d) does not match the "
1655                          "variable's width (%d)."),
1656                     var_name, width, var_get_width (v));
1657           skip_long_string_value_labels (r, n_labels);
1658           continue;
1659         }
1660
1661       /* Read values. */
1662       value_init_pool (r->pool, &value, width);
1663       for (i = 0; i < n_labels; i++)
1664         {
1665           size_t value_length, label_length;
1666           char label[256];
1667           bool skip = false;
1668
1669           /* Read value. */
1670           value_length = read_int (r);
1671           if (value_length == width)
1672             read_bytes (r, value_str_rw (&value, width), width);
1673           else
1674             {
1675               sys_warn (r, _("Ignoring long string value %zu for variable %s, "
1676                              "with width %d, that has bad value width %zu."),
1677                         i, var_get_name (v), width, value_length);
1678               skip_bytes (r, value_length);
1679               skip = true;
1680             }
1681
1682           /* Read label. */
1683           label_length = read_int (r);
1684           read_string (r, label, MIN (sizeof label, label_length + 1));
1685           if (label_length >= sizeof label)
1686             {
1687               /* Skip and silently ignore label text after the
1688                  first 255 bytes.  The maximum documented length
1689                  of a label is 120 bytes so this is more than
1690                  generous. */
1691               skip_bytes (r, (label_length + 1) - sizeof label);
1692             }
1693
1694           if (!skip && !var_add_value_label (v, &value, label))
1695             sys_warn (r, _("Duplicate value label for `%.*s' on %s."),
1696                       width, value_str (&value, width), var_get_name (v));
1697         }
1698     }
1699 }
1700
1701
1702 /* Reads record type 7, subtype 18, which lists custom
1703    attributes on individual variables.  */
1704 static void
1705 read_variable_attributes (struct sfm_reader *r,
1706                           size_t size, size_t count,
1707                           struct dictionary *dict)
1708 {
1709   struct text_record *text = open_text_record (r, size * count);
1710   for (;;)
1711     {
1712       struct variable *var;
1713       if (!text_read_variable_name (r, dict, text, ss_cstr (":"), &var))
1714         break;
1715       read_attributes (r, text, var != NULL ? var_get_attributes (var) : NULL);
1716     }
1717   close_text_record (r, text);
1718 }
1719
1720 \f
1721 /* Case reader. */
1722
1723 static void partial_record (struct sfm_reader *r)
1724      NO_RETURN;
1725
1726 static void read_error (struct casereader *, const struct sfm_reader *);
1727
1728 static bool read_case_number (struct sfm_reader *, double *);
1729 static bool read_case_string (struct sfm_reader *, uint8_t *, size_t);
1730 static int read_opcode (struct sfm_reader *);
1731 static bool read_compressed_number (struct sfm_reader *, double *);
1732 static bool read_compressed_string (struct sfm_reader *, uint8_t *);
1733 static bool read_whole_strings (struct sfm_reader *, uint8_t *, size_t);
1734 static bool skip_whole_strings (struct sfm_reader *, size_t);
1735
1736 /* Reads and returns one case from READER's file.  Returns a null
1737    pointer if not successful. */
1738 static struct ccase *
1739 sys_file_casereader_read (struct casereader *reader, void *r_)
1740 {
1741   struct sfm_reader *r = r_;
1742   struct ccase *volatile c;
1743   int i;
1744
1745   if (r->error)
1746     return NULL;
1747
1748   c = case_create (r->proto);
1749   if (setjmp (r->bail_out))
1750     {
1751       casereader_force_error (reader);
1752       case_unref (c);
1753       return NULL;
1754     }
1755
1756   for (i = 0; i < r->sfm_var_cnt; i++)
1757     {
1758       struct sfm_var *sv = &r->sfm_vars[i];
1759       union value *v = case_data_rw_idx (c, sv->case_index);
1760
1761       if (sv->var_width == 0)
1762         {
1763           if (!read_case_number (r, &v->f))
1764             goto eof;
1765         }
1766       else
1767         {
1768           uint8_t *s = value_str_rw (v, sv->var_width);
1769           if (!read_case_string (r, s + sv->offset, sv->segment_width))
1770             goto eof;
1771           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
1772             partial_record (r);
1773         }
1774     }
1775   return c;
1776
1777 eof:
1778   if (i != 0)
1779     partial_record (r);
1780   if (r->case_cnt != -1)
1781     read_error (reader, r);
1782   case_unref (c);
1783   return NULL;
1784 }
1785
1786 /* Issues an error that R ends in a partial record. */
1787 static void
1788 partial_record (struct sfm_reader *r)
1789 {
1790   sys_error (r, _("File ends in partial case."));
1791 }
1792
1793 /* Issues an error that an unspecified error occurred SFM, and
1794    marks R tainted. */
1795 static void
1796 read_error (struct casereader *r, const struct sfm_reader *sfm)
1797 {
1798   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
1799   casereader_force_error (r);
1800 }
1801
1802 /* Reads a number from R and stores its value in *D.
1803    If R is compressed, reads a compressed number;
1804    otherwise, reads a number in the regular way.
1805    Returns true if successful, false if end of file is
1806    reached immediately. */
1807 static bool
1808 read_case_number (struct sfm_reader *r, double *d)
1809 {
1810   if (!r->compressed)
1811     {
1812       uint8_t number[8];
1813       if (!try_read_bytes (r, number, sizeof number))
1814         return false;
1815       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
1816       return true;
1817     }
1818   else
1819     return read_compressed_number (r, d);
1820 }
1821
1822 /* Reads LENGTH string bytes from R into S.
1823    Always reads a multiple of 8 bytes; if LENGTH is not a
1824    multiple of 8, then extra bytes are read and discarded without
1825    being written to S.
1826    Reads compressed strings if S is compressed.
1827    Returns true if successful, false if end of file is
1828    reached immediately. */
1829 static bool
1830 read_case_string (struct sfm_reader *r, uint8_t *s, size_t length)
1831 {
1832   size_t whole = ROUND_DOWN (length, 8);
1833   size_t partial = length % 8;
1834
1835   if (whole)
1836     {
1837       if (!read_whole_strings (r, s, whole))
1838         return false;
1839     }
1840
1841   if (partial)
1842     {
1843       uint8_t bounce[8];
1844       if (!read_whole_strings (r, bounce, sizeof bounce))
1845         {
1846           if (whole)
1847             partial_record (r);
1848           return false;
1849         }
1850       memcpy (s + whole, bounce, partial);
1851     }
1852
1853   return true;
1854 }
1855
1856 /* Reads and returns the next compression opcode from R. */
1857 static int
1858 read_opcode (struct sfm_reader *r)
1859 {
1860   assert (r->compressed);
1861   for (;;)
1862     {
1863       int opcode;
1864       if (r->opcode_idx >= sizeof r->opcodes)
1865         {
1866           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
1867             return -1;
1868           r->opcode_idx = 0;
1869         }
1870       opcode = r->opcodes[r->opcode_idx++];
1871
1872       if (opcode != 0)
1873         return opcode;
1874     }
1875 }
1876
1877 /* Reads a compressed number from R and stores its value in D.
1878    Returns true if successful, false if end of file is
1879    reached immediately. */
1880 static bool
1881 read_compressed_number (struct sfm_reader *r, double *d)
1882 {
1883   int opcode = read_opcode (r);
1884   switch (opcode)
1885     {
1886     case -1:
1887     case 252:
1888       return false;
1889
1890     case 253:
1891       *d = read_float (r);
1892       break;
1893
1894     case 254:
1895       float_convert (r->float_format, "        ", FLOAT_NATIVE_DOUBLE, d);
1896       if (!r->corruption_warning)
1897         {
1898           r->corruption_warning = true;
1899           sys_warn (r, _("Possible compressed data corruption: "
1900                          "compressed spaces appear in numeric field."));
1901         }
1902       break;
1903
1904     case 255:
1905       *d = SYSMIS;
1906       break;
1907
1908     default:
1909       *d = opcode - r->bias;
1910       break;
1911     }
1912
1913   return true;
1914 }
1915
1916 /* Reads a compressed 8-byte string segment from R and stores it
1917    in DST.
1918    Returns true if successful, false if end of file is
1919    reached immediately. */
1920 static bool
1921 read_compressed_string (struct sfm_reader *r, uint8_t *dst)
1922 {
1923   int opcode = read_opcode (r);
1924   switch (opcode)
1925     {
1926     case -1:
1927     case 252:
1928       return false;
1929
1930     case 253:
1931       read_bytes (r, dst, 8);
1932       break;
1933
1934     case 254:
1935       memset (dst, ' ', 8);
1936       break;
1937
1938     default:
1939       {
1940         double value = opcode - r->bias;
1941         float_convert (FLOAT_NATIVE_DOUBLE, &value, r->float_format, dst);
1942         if (value == 0.0)
1943           {
1944             /* This has actually been seen "in the wild".  The submitter of the
1945                file that showed that the contents decoded as spaces, but they
1946                were at the end of the field so it's possible that the null
1947                bytes just acted as null terminators. */
1948           }
1949         else if (!r->corruption_warning)
1950           {
1951             r->corruption_warning = true;
1952             sys_warn (r, _("Possible compressed data corruption: "
1953                            "string contains compressed integer (opcode %d)."),
1954                       opcode);
1955           }
1956       }
1957       break;
1958     }
1959
1960   return true;
1961 }
1962
1963 /* Reads LENGTH string bytes from R into S.
1964    LENGTH must be a multiple of 8.
1965    Reads compressed strings if S is compressed.
1966    Returns true if successful, false if end of file is
1967    reached immediately. */
1968 static bool
1969 read_whole_strings (struct sfm_reader *r, uint8_t *s, size_t length)
1970 {
1971   assert (length % 8 == 0);
1972   if (!r->compressed)
1973     return try_read_bytes (r, s, length);
1974   else
1975     {
1976       size_t ofs;
1977       for (ofs = 0; ofs < length; ofs += 8)
1978         if (!read_compressed_string (r, s + ofs))
1979           {
1980             if (ofs != 0)
1981               partial_record (r);
1982             return false;
1983           }
1984       return true;
1985     }
1986 }
1987
1988 /* Skips LENGTH string bytes from R.
1989    LENGTH must be a multiple of 8.
1990    (LENGTH is also limited to 1024, but that's only because the
1991    current caller never needs more than that many bytes.)
1992    Returns true if successful, false if end of file is
1993    reached immediately. */
1994 static bool
1995 skip_whole_strings (struct sfm_reader *r, size_t length)
1996 {
1997   uint8_t buffer[1024];
1998   assert (length < sizeof buffer);
1999   return read_whole_strings (r, buffer, length);
2000 }
2001 \f
2002 /* Creates and returns a table that can be used for translating a value
2003    index into a case to a "struct variable *" for DICT.  Multiple
2004    system file fields reference variables this way.
2005
2006    This table must be created before processing the very long
2007    string extension record, because that record causes some
2008    values to be deleted from the case and the dictionary to be
2009    compacted. */
2010 static struct variable **
2011 make_var_by_value_idx (struct sfm_reader *r, struct dictionary *dict)
2012 {
2013   struct variable **var_by_value_idx;
2014   int value_idx = 0;
2015   int i;
2016
2017   var_by_value_idx = pool_nmalloc (r->pool,
2018                                    r->oct_cnt, sizeof *var_by_value_idx);
2019   for (i = 0; i < dict_get_var_cnt (dict); i++)
2020     {
2021       struct variable *v = dict_get_var (dict, i);
2022       int nv = var_is_numeric (v) ? 1 : DIV_RND_UP (var_get_width (v), 8);
2023       int j;
2024
2025       var_by_value_idx[value_idx++] = v;
2026       for (j = 1; j < nv; j++)
2027         var_by_value_idx[value_idx++] = NULL;
2028     }
2029   assert (value_idx == r->oct_cnt);
2030
2031   return var_by_value_idx;
2032 }
2033
2034 /* Returns the "struct variable" corresponding to the given
2035    1-basd VALUE_IDX in VAR_BY_VALUE_IDX.  Verifies that the index
2036    is valid. */
2037 static struct variable *
2038 lookup_var_by_value_idx (struct sfm_reader *r,
2039                          struct variable **var_by_value_idx, int value_idx)
2040 {
2041   struct variable *var;
2042
2043   if (value_idx < 1 || value_idx > r->oct_cnt)
2044     sys_error (r, _("Variable index %d not in valid range 1...%d."),
2045                value_idx, r->oct_cnt);
2046
2047   var = var_by_value_idx[value_idx - 1];
2048   if (var == NULL)
2049     sys_error (r, _("Variable index %d refers to long string "
2050                     "continuation."),
2051                value_idx);
2052
2053   return var;
2054 }
2055
2056 /* Returns the variable in D with the given SHORT_NAME,
2057    or a null pointer if there is none. */
2058 static struct variable *
2059 lookup_var_by_short_name (struct dictionary *d, const char *short_name)
2060 {
2061   struct variable *var;
2062   size_t var_cnt;
2063   size_t i;
2064
2065   /* First try looking up by full name.  This often succeeds. */
2066   var = dict_lookup_var (d, short_name);
2067   if (var != NULL && !strcasecmp (var_get_short_name (var, 0), short_name))
2068     return var;
2069
2070   /* Iterate through the whole dictionary as a fallback. */
2071   var_cnt = dict_get_var_cnt (d);
2072   for (i = 0; i < var_cnt; i++)
2073     {
2074       var = dict_get_var (d, i);
2075       if (!strcasecmp (var_get_short_name (var, 0), short_name))
2076         return var;
2077     }
2078
2079   return NULL;
2080 }
2081 \f
2082 /* Helpers for reading records that contain structured text
2083    strings. */
2084
2085 /* Maximum number of warnings to issue for a single text
2086    record. */
2087 #define MAX_TEXT_WARNINGS 5
2088
2089 /* State. */
2090 struct text_record
2091   {
2092     struct substring buffer;    /* Record contents. */
2093     size_t pos;                 /* Current position in buffer. */
2094     int n_warnings;             /* Number of warnings issued or suppressed. */
2095   };
2096
2097 /* Reads SIZE bytes into a text record for R,
2098    and returns the new text record. */
2099 static struct text_record *
2100 open_text_record (struct sfm_reader *r, size_t size)
2101 {
2102   struct text_record *text = pool_alloc (r->pool, sizeof *text);
2103   char *buffer = pool_malloc (r->pool, size + 1);
2104   read_bytes (r, buffer, size);
2105   text->buffer = ss_buffer (buffer, size);
2106   text->pos = 0;
2107   text->n_warnings = 0;
2108   return text;
2109 }
2110
2111 /* Closes TEXT, frees its storage, and issues a final warning
2112    about suppressed warnings if necesary. */
2113 static void
2114 close_text_record (struct sfm_reader *r, struct text_record *text)
2115 {
2116   if (text->n_warnings > MAX_TEXT_WARNINGS)
2117     sys_warn (r, _("Suppressed %d additional related warnings."),
2118               text->n_warnings - MAX_TEXT_WARNINGS);
2119   pool_free (r->pool, ss_data (text->buffer));
2120 }
2121
2122 /* Reads a variable=value pair from TEXT.
2123    Looks up the variable in DICT and stores it into *VAR.
2124    Stores a null-terminated value into *VALUE. */
2125 static bool
2126 read_variable_to_value_pair (struct sfm_reader *r, struct dictionary *dict,
2127                              struct text_record *text,
2128                              struct variable **var, char **value)
2129 {
2130   for (;;)
2131     {
2132       if (!text_read_short_name (r, dict, text, ss_cstr ("="), var))
2133         return false;
2134
2135       *value = text_get_token (text, ss_buffer ("\t\0", 2), NULL);
2136       if (*value == NULL)
2137         return false;
2138
2139       text->pos += ss_span (ss_substr (text->buffer, text->pos, SIZE_MAX),
2140                             ss_buffer ("\t\0", 2));
2141
2142       if (*var != NULL)
2143         return true;
2144     }
2145 }
2146
2147 static bool
2148 text_read_variable_name (struct sfm_reader *r, struct dictionary *dict,
2149                          struct text_record *text, struct substring delimiters,
2150                          struct variable **var)
2151 {
2152   char *name;
2153
2154   name = text_get_token (text, delimiters, NULL);
2155   if (name == NULL)
2156     return false;
2157
2158   *var = dict_lookup_var (dict, name);
2159   if (*var != NULL)
2160     return true;
2161
2162   text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2163              name);
2164   return false;
2165 }
2166
2167
2168 static bool
2169 text_read_short_name (struct sfm_reader *r, struct dictionary *dict,
2170                       struct text_record *text, struct substring delimiters,
2171                       struct variable **var)
2172 {
2173   char *short_name = text_get_token (text, delimiters, NULL);
2174   if (short_name == NULL)
2175     return false;
2176
2177   *var = lookup_var_by_short_name (dict, short_name);
2178   if (*var == NULL)
2179     text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2180                short_name);
2181   return true;
2182 }
2183
2184 /* Displays a warning for the current file position, limiting the
2185    number to MAX_TEXT_WARNINGS for TEXT. */
2186 static void
2187 text_warn (struct sfm_reader *r, struct text_record *text,
2188            const char *format, ...)
2189 {
2190   if (text->n_warnings++ < MAX_TEXT_WARNINGS)
2191     {
2192       va_list args;
2193
2194       va_start (args, format);
2195       sys_msg (r, MW, format, args);
2196       va_end (args);
2197     }
2198 }
2199
2200 static char *
2201 text_get_token (struct text_record *text, struct substring delimiters,
2202                 char *delimiter)
2203 {
2204   struct substring token;
2205   char *end;
2206
2207   if (!ss_tokenize (text->buffer, delimiters, &text->pos, &token))
2208     return NULL;
2209
2210   end = &ss_data (token)[ss_length (token)];
2211   if (delimiter != NULL)
2212     *delimiter = *end;
2213   *end = '\0';
2214   return ss_data (token);
2215 }
2216
2217 /* Reads a integer value expressed in decimal, then a space, then a string that
2218    consists of exactly as many bytes as specified by the integer, then a space,
2219    from TEXT.  Returns the string, null-terminated, as a subset of TEXT's
2220    buffer (so the caller should not free the string). */
2221 static const char *
2222 text_parse_counted_string (struct sfm_reader *r, struct text_record *text)
2223 {
2224   size_t start;
2225   size_t n;
2226   char *s;
2227
2228   start = text->pos;
2229   n = 0;
2230   for (;;)
2231     {
2232       int c = text->buffer.string[text->pos];
2233       if (c < '0' || c > '9')
2234         break;
2235       n = (n * 10) + (c - '0');
2236       text->pos++;
2237     }
2238   if (start == text->pos)
2239     {
2240       sys_warn (r, _("Expecting digit at offset %zu in MRSETS record."),
2241                  text->pos);
2242       return NULL;
2243     }
2244
2245   if (!text_match (text, ' '))
2246     {
2247       sys_warn (r, _("Expecting space at offset %zu in MRSETS record."),
2248                 text->pos);
2249       return NULL;
2250     }
2251
2252   if (text->pos + n > text->buffer.length)
2253     {
2254       sys_warn (r, _("%zu-byte string starting at offset %zu "
2255                      "exceeds record length %zu."),
2256                 n, text->pos, text->buffer.length);
2257       return NULL;
2258     }
2259
2260   s = &text->buffer.string[text->pos];
2261   if (s[n] != ' ')
2262     {
2263       sys_warn (r,
2264                 _("Expecting space at offset %zu following %zu-byte string."),
2265                 text->pos + n, n);
2266       return NULL;
2267     }
2268   s[n] = '\0';
2269   text->pos += n + 1;
2270   return s;
2271 }
2272
2273 static bool
2274 text_match (struct text_record *text, char c)
2275 {
2276   if (text->buffer.string[text->pos] == c)
2277     {
2278       text->pos++;
2279       return true;
2280     }
2281   else
2282     return false;
2283 }
2284
2285 /* Returns the current byte offset inside the TEXT's string. */
2286 static size_t
2287 text_pos (const struct text_record *text)
2288 {
2289   return text->pos;
2290 }
2291 \f
2292 /* Messages. */
2293
2294 /* Displays a corruption message. */
2295 static void
2296 sys_msg (struct sfm_reader *r, int class, const char *format, va_list args)
2297 {
2298   struct msg m;
2299   struct string text;
2300
2301   ds_init_empty (&text);
2302   ds_put_format (&text, "`%s' near offset 0x%llx: ",
2303                  fh_get_file_name (r->fh), (long long int) ftello (r->file));
2304   ds_put_vformat (&text, format, args);
2305
2306   m.category = msg_class_to_category (class);
2307   m.severity = msg_class_to_severity (class);
2308   m.where.file_name = NULL;
2309   m.where.line_number = 0;
2310   m.where.first_column = 0;
2311   m.where.last_column = 0;
2312   m.text = ds_cstr (&text);
2313
2314   msg_emit (&m);
2315 }
2316
2317 /* Displays a warning for the current file position. */
2318 static void
2319 sys_warn (struct sfm_reader *r, const char *format, ...)
2320 {
2321   va_list args;
2322
2323   va_start (args, format);
2324   sys_msg (r, MW, format, args);
2325   va_end (args);
2326 }
2327
2328 /* Displays an error for the current file position,
2329    marks it as in an error state,
2330    and aborts reading it using longjmp. */
2331 static void
2332 sys_error (struct sfm_reader *r, const char *format, ...)
2333 {
2334   va_list args;
2335
2336   va_start (args, format);
2337   sys_msg (r, ME, format, args);
2338   va_end (args);
2339
2340   r->error = true;
2341   longjmp (r->bail_out, 1);
2342 }
2343 \f
2344 /* Reads BYTE_CNT bytes into BUF.
2345    Returns true if exactly BYTE_CNT bytes are successfully read.
2346    Aborts if an I/O error or a partial read occurs.
2347    If EOF_IS_OK, then an immediate end-of-file causes false to be
2348    returned; otherwise, immediate end-of-file causes an abort
2349    too. */
2350 static inline bool
2351 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
2352                    void *buf, size_t byte_cnt)
2353 {
2354   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
2355   if (bytes_read == byte_cnt)
2356     return true;
2357   else if (ferror (r->file))
2358     sys_error (r, _("System error: %s."), strerror (errno));
2359   else if (!eof_is_ok || bytes_read != 0)
2360     sys_error (r, _("Unexpected end of file."));
2361   else
2362     return false;
2363 }
2364
2365 /* Reads BYTE_CNT into BUF.
2366    Aborts upon I/O error or if end-of-file is encountered. */
2367 static void
2368 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2369 {
2370   read_bytes_internal (r, false, buf, byte_cnt);
2371 }
2372
2373 /* Reads BYTE_CNT bytes into BUF.
2374    Returns true if exactly BYTE_CNT bytes are successfully read.
2375    Returns false if an immediate end-of-file is encountered.
2376    Aborts if an I/O error or a partial read occurs. */
2377 static bool
2378 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2379 {
2380   return read_bytes_internal (r, true, buf, byte_cnt);
2381 }
2382
2383 /* Reads a 32-bit signed integer from R and returns its value in
2384    host format. */
2385 static int
2386 read_int (struct sfm_reader *r)
2387 {
2388   uint8_t integer[4];
2389   read_bytes (r, integer, sizeof integer);
2390   return integer_get (r->integer_format, integer, sizeof integer);
2391 }
2392
2393 /* Reads a 64-bit floating-point number from R and returns its
2394    value in host format. */
2395 static double
2396 read_float (struct sfm_reader *r)
2397 {
2398   uint8_t number[8];
2399   read_bytes (r, number, sizeof number);
2400   return float_get_double (r->float_format, number);
2401 }
2402
2403 /* Reads exactly SIZE - 1 bytes into BUFFER
2404    and stores a null byte into BUFFER[SIZE - 1]. */
2405 static void
2406 read_string (struct sfm_reader *r, char *buffer, size_t size)
2407 {
2408   assert (size > 0);
2409   read_bytes (r, buffer, size - 1);
2410   buffer[size - 1] = '\0';
2411 }
2412
2413 /* Skips BYTES bytes forward in R. */
2414 static void
2415 skip_bytes (struct sfm_reader *r, size_t bytes)
2416 {
2417   while (bytes > 0)
2418     {
2419       char buffer[1024];
2420       size_t chunk = MIN (sizeof buffer, bytes);
2421       read_bytes (r, buffer, chunk);
2422       bytes -= chunk;
2423     }
2424 }
2425 \f
2426 static const struct casereader_class sys_file_casereader_class =
2427   {
2428     sys_file_casereader_read,
2429     sys_file_casereader_destroy,
2430     NULL,
2431     NULL,
2432   };