src/data/sys-file-reader.c

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