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   bool recode_to_utf8);
 208 static void close_text_record (struct sfm_reader *,
 209                                struct text_record *);
 210 static bool read_variable_to_value_pair (struct sfm_reader *,
 211                                          struct dictionary *,
 212                                          struct text_record *,
 213                                          struct variable **var, char **value);
 214 static void text_warn (struct sfm_reader *r, struct text_record *text,
 215                        const char *format, ...)
 216   PRINTF_FORMAT (3, 4);
 217 static char *text_get_token (struct text_record *,
 218                              struct substring delimiters, char *delimiter);
 219 static bool text_match (struct text_record *, char c);
 220 static bool text_read_variable_name (struct sfm_reader *, struct dictionary *,
 221                                      struct text_record *,
 222                                      struct substring delimiters,
 223                                      struct variable **);
 224 static bool text_read_short_name (struct sfm_reader *, struct dictionary *,
 225                                   struct text_record *,
 226                                   struct substring delimiters,
 227                                   struct variable **);
 228 static const char *text_parse_counted_string (struct sfm_reader *,
 229                                               struct text_record *);
 230 static size_t text_pos (const struct text_record *);
 231
 232 static bool close_reader (struct sfm_reader *r);
 233 \f
 234 /* Dictionary reader. */
 235
 236 enum which_format
 237   {
 238     PRINT_FORMAT,
 239     WRITE_FORMAT
 240   };
 241
 242 static void read_header (struct sfm_reader *, int *weight_idx,
 243                          int *claimed_oct_cnt, struct sfm_read_info *,
 244                          char **file_labelp);
 245 static void parse_file_label (struct sfm_reader *, const char *file_label,
 246                               struct dictionary *);
 247 static void parse_variable_records (struct sfm_reader *, struct dictionary *,
 248                                     struct sfm_var_record *, size_t n);
 249 static void parse_format_spec (struct sfm_reader *, off_t pos,
 250                                unsigned int format, enum which_format,
 251                                struct variable *, int *format_warning_cnt);
 252 static void parse_document (struct dictionary *, struct sfm_document_record *);
 253 static void parse_display_parameters (struct sfm_reader *,
 254                                       const struct sfm_extension_record *,
 255                                       struct dictionary *);
 256 static void parse_machine_integer_info (struct sfm_reader *,
 257                                         const struct sfm_extension_record *,
 258                                         struct sfm_read_info *);
 259 static void parse_machine_float_info (struct sfm_reader *,
 260                                       const struct sfm_extension_record *);
 261 static void parse_mrsets (struct sfm_reader *,
 262                           const struct sfm_extension_record *,
 263                           struct dictionary *);
 264 static void parse_long_var_name_map (struct sfm_reader *,
 265                                      const struct sfm_extension_record *,
 266                                      struct dictionary *);
 267 static void parse_long_string_map (struct sfm_reader *,
 268                                    const struct sfm_extension_record *,
 269                                    struct dictionary *);
 270 static void parse_value_labels (struct sfm_reader *, struct dictionary *,
 271                                 const struct sfm_var_record *,
 272                                 size_t n_var_recs,
 273                                 const struct sfm_value_label_record *);
 274 static void parse_data_file_attributes (struct sfm_reader *,
 275                                         const struct sfm_extension_record *,
 276                                         struct dictionary *);
 277 static void parse_variable_attributes (struct sfm_reader *,
 278                                        const struct sfm_extension_record *,
 279                                        struct dictionary *);
 280 static void parse_long_string_value_labels (struct sfm_reader *,
 281                                             const struct sfm_extension_record *,
 282                                             struct dictionary *);
 283
 284 /* Opens the system file designated by file handle FH for
 285    reading.  Reads the system file's dictionary into *DICT.
 286    If INFO is non-null, then it receives additional info about the
 287    system file. */
 288 struct casereader *
 289 sfm_open_reader (struct file_handle *fh, struct dictionary **dictp,
 290                  struct sfm_read_info *volatile info)
 291 {
 292   struct sfm_reader *volatile r = NULL;
 293   struct sfm_read_info local_info;
 294
 295   struct sfm_var_record *vars;
 296   size_t n_vars, allocated_vars;
 297
 298   struct sfm_value_label_record *labels;
 299   size_t n_labels, allocated_labels;
 300
 301   struct sfm_document_record *document;
 302
 303   struct sfm_extension_record *extensions[32];
 304
 305   int weight_idx;
 306   int claimed_oct_cnt;
 307   char *file_label;
 308
 309   struct dictionary *dict = NULL;
 310   size_t i;
 311
 312   /* Create and initialize reader. */
 313   r = pool_create_container (struct sfm_reader, pool);
 314   r->fh = fh_ref (fh);
 315   r->lock = NULL;
 316   r->file = NULL;
 317   r->pos = 0;
 318   r->error = false;
 319   r->opcode_idx = sizeof r->opcodes;
 320   r->corruption_warning = false;
 321
 322   /* TRANSLATORS: this fragment will be interpolated into
 323      messages in fh_lock() that identify types of files. */
 324   r->lock = fh_lock (fh, FH_REF_FILE, N_("system file"), FH_ACC_READ, false);
 325   if (r->lock == NULL)
 326     goto error;
 327
 328   r->file = fn_open (fh_get_file_name (fh), "rb");
 329   if (r->file == NULL)
 330     {
 331       msg (ME, _("Error opening `%s' for reading as a system file: %s."),
 332            fh_get_file_name (r->fh), strerror (errno));
 333       goto error;
 334     }
 335
 336   /* Initialize info. */
 337   if (info == NULL)
 338     info = &local_info;
 339   memset (info, 0, sizeof *info);
 340
 341   if (setjmp (r->bail_out))
 342     goto error;
 343
 344   /* Read header. */
 345   read_header (r, &weight_idx, &claimed_oct_cnt, info, &file_label);
 346
 347   vars = NULL;
 348   n_vars = allocated_vars = 0;
 349
 350   labels = NULL;
 351   n_labels = allocated_labels = 0;
 352
 353   document = NULL;
 354
 355   memset (extensions, 0, sizeof extensions);
 356
 357   for (;;)
 358     {
 359       int subtype;
 360       int type;
 361
 362       type = read_int (r);
 363       if (type == 999)
 364         {
 365           read_int (r);         /* Skip filler. */
 366           break;
 367         }
 368
 369       switch (type)
 370         {
 371         case 2:
 372           if (n_vars >= allocated_vars)
 373             vars = pool_2nrealloc (r->pool, vars, &allocated_vars,
 374                                    sizeof *vars);
 375           read_variable_record (r, &vars[n_vars++]);
 376           break;
 377
 378         case 3:
 379           if (n_labels >= allocated_labels)
 380             labels = pool_2nrealloc (r->pool, labels, &allocated_labels,
 381                                      sizeof *labels);
 382           read_value_label_record (r, &labels[n_labels++], n_vars);
 383           break;
 384
 385         case 4:
 386           /* A Type 4 record is always immediately after a type 3 record,
 387              so the code for type 3 records reads the type 4 record too. */
 388           sys_error (r, r->pos, _("Misplaced type 4 record."));
 389
 390         case 6:
 391           if (document != NULL)
 392             sys_error (r, r->pos, _("Duplicate type 6 (document) record."));
 393           document = read_document_record (r);
 394           break;
 395
 396         case 7:
 397           subtype = read_int (r);
 398           if (subtype < 0 || subtype >= sizeof extensions / sizeof *extensions)
 399             {
 400               sys_warn (r, r->pos,
 401                         _("Unrecognized record type 7, subtype %d.  Please "
 402                           "send a copy of this file, and the syntax which "
 403                           "created it to %s."),
 404                         subtype, PACKAGE_BUGREPORT);
 405               skip_extension_record (r, subtype);
 406             }
 407           else if (extensions[subtype] != NULL)
 408             {
 409               sys_warn (r, r->pos,
 410                         _("Record type 7, subtype %d found here has the same "
 411                           "type as the record found near offset 0x%llx.  "
 412                           "Please send a copy of this file, and the syntax "
 413                           "which created it to %s."),
 414                         subtype, (long long int) extensions[subtype]->pos,
 415                         PACKAGE_BUGREPORT);
 416               skip_extension_record (r, subtype);
 417             }
 418           else
 419             extensions[subtype] = read_extension_record (r, subtype);
 420           break;
 421
 422         default:
 423           sys_error (r, r->pos, _("Unrecognized record type %d."), type);
 424           goto error;
 425         }
 426     }
 427
 428   /* Now actually parse what we read.
 429
 430      First, figure out the correct character encoding, because this determines
 431      how the rest of the header data is to be interpreted. */
 432   dict = dict_create (choose_encoding (r, extensions[EXT_INTEGER],
 433                                        extensions[EXT_ENCODING]));
 434   r->encoding = dict_get_encoding (dict);
 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, 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, false);
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 = recode_string ("UTF-8", r->encoding, name, -1);
1248
1249       if (mrset->name[0] != '$')
1250         {
1251           sys_warn (r, record->pos,
1252                     _("`%s' does not begin with `$' at 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 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 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 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 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       if (label[0] != '\0')
1316         mrset->label = recode_string ("UTF-8", r->encoding, label, -1);
1317
1318       stringi_set_init (&var_names);
1319       allocated_vars = 0;
1320       width = INT_MAX;
1321       do
1322         {
1323           const char *raw_var_name;
1324           struct variable *var;
1325           char *var_name;
1326
1327           raw_var_name = text_get_token (text, ss_cstr (" \n"), &delimiter);
1328           if (raw_var_name == NULL)
1329             {
1330               sys_warn (r, record->pos,
1331                         _("Missing new-line parsing variable names "
1332                           "at offset %zu in MRSETS record."),
1333                         text_pos (text));
1334               break;
1335             }
1336           var_name = recode_string ("UTF-8", r->encoding, raw_var_name, -1);
1337
1338           var = dict_lookup_var (dict, var_name);
1339           if (var == NULL)
1340             {
1341               free (var_name);
1342               continue;
1343             }
1344           if (!stringi_set_insert (&var_names, var_name))
1345             {
1346               sys_warn (r, record->pos,
1347                         _("Duplicate variable name %s "
1348                           "at offset %zu in MRSETS record."),
1349                         var_name, text_pos (text));
1350               free (var_name);
1351               continue;
1352             }
1353           free (var_name);
1354
1355           if (mrset->label == NULL && mrset->label_from_var_label
1356               && var_has_label (var))
1357             mrset->label = xstrdup (var_get_label (var));
1358
1359           if (mrset->n_vars
1360               && var_get_type (var) != var_get_type (mrset->vars[0]))
1361             {
1362               sys_warn (r, record->pos,
1363                         _("MRSET %s contains both string and "
1364                           "numeric variables."), name);
1365               continue;
1366             }
1367           width = MIN (width, var_get_width (var));
1368
1369           if (mrset->n_vars >= allocated_vars)
1370             mrset->vars = x2nrealloc (mrset->vars, &allocated_vars,
1371                                       sizeof *mrset->vars);
1372           mrset->vars[mrset->n_vars++] = var;
1373         }
1374       while (delimiter != '\n');
1375
1376       if (mrset->n_vars < 2)
1377         {
1378           sys_warn (r, record->pos,
1379                     _("MRSET %s has only %zu variables."), mrset->name,
1380                     mrset->n_vars);
1381           mrset_destroy (mrset);
1382           continue;
1383         }
1384
1385       if (mrset->type == MRSET_MD)
1386         {
1387           mrset->width = width;
1388           value_init (&mrset->counted, width);
1389           if (width == 0)
1390             mrset->counted.f = strtod (counted, NULL);
1391           else
1392             value_copy_str_rpad (&mrset->counted, width,
1393                                  (const uint8_t *) counted, ' ');
1394         }
1395
1396       dict_add_mrset (dict, mrset);
1397       mrset = NULL;
1398       stringi_set_destroy (&var_names);
1399     }
1400   mrset_destroy (mrset);
1401   close_text_record (r, text);
1402 }
1403
1404 /* Read record type 7, subtype 11, which specifies how variables
1405    should be displayed in GUI environments. */
1406 static void
1407 parse_display_parameters (struct sfm_reader *r,
1408                          const struct sfm_extension_record *record,
1409                          struct dictionary *dict)
1410 {
1411   bool includes_width;
1412   bool warned = false;
1413   size_t n_vars;
1414   size_t ofs;
1415   size_t i;
1416
1417   n_vars = dict_get_var_cnt (dict);
1418   if (record->count == 3 * n_vars)
1419     includes_width = true;
1420   else if (record->count == 2 * n_vars)
1421     includes_width = false;
1422   else
1423     {
1424       sys_warn (r, record->pos,
1425                 _("Extension 11 has bad count %zu (for %zu variables)."),
1426                 record->count, n_vars);
1427       return;
1428     }
1429
1430   ofs = 0;
1431   for (i = 0; i < n_vars; ++i)
1432     {
1433       struct variable *v = dict_get_var (dict, i);
1434       int measure, width, align;
1435
1436       measure = parse_int (r, record->data, ofs);
1437       ofs += 4;
1438
1439       if (includes_width)
1440         {
1441           width = parse_int (r, record->data, ofs);
1442           ofs += 4;
1443         }
1444       else
1445         width = 0;
1446
1447       align = parse_int (r, record->data, ofs);
1448       ofs += 4;
1449
1450       /* SPSS 14 sometimes seems to set string variables' measure
1451          to zero. */
1452       if (0 == measure && var_is_alpha (v))
1453         measure = 1;
1454
1455       if (measure < 1 || measure > 3 || align < 0 || align > 2)
1456         {
1457           if (!warned)
1458             sys_warn (r, record->pos,
1459                       _("Invalid variable display parameters for variable "
1460                         "%zu (%s).  Default parameters substituted."),
1461                       i, var_get_name (v));
1462           warned = true;
1463           continue;
1464         }
1465
1466       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
1467                            : measure == 2 ? MEASURE_ORDINAL
1468                            : MEASURE_SCALE));
1469       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
1470                              : align == 1 ? ALIGN_RIGHT
1471                              : ALIGN_CENTRE));
1472
1473       /* Older versions (SPSS 9.0) sometimes set the display
1474          width to zero.  This causes confusion in the GUI, so
1475          only set the width if it is nonzero. */
1476       if (width > 0)
1477         var_set_display_width (v, width);
1478     }
1479 }
1480
1481 static void
1482 rename_var_and_save_short_names (struct dictionary *dict, struct variable *var,
1483                                  const char *new_name)
1484 {
1485   size_t n_short_names;
1486   char **short_names;
1487   size_t i;
1488
1489   /* Renaming a variable may clear its short names, but we
1490      want to retain them, so we save them and re-set them
1491      afterward. */
1492   n_short_names = var_get_short_name_cnt (var);
1493   short_names = xnmalloc (n_short_names, sizeof *short_names);
1494   for (i = 0; i < n_short_names; i++)
1495     {
1496       const char *s = var_get_short_name (var, i);
1497       short_names[i] = s != NULL ? xstrdup (s) : NULL;
1498     }
1499
1500   /* Set long name. */
1501   dict_rename_var (dict, var, new_name);
1502
1503   /* Restore short names. */
1504   for (i = 0; i < n_short_names; i++)
1505     {
1506       var_set_short_name (var, i, short_names[i]);
1507       free (short_names[i]);
1508     }
1509   free (short_names);
1510 }
1511
1512 /* Parses record type 7, subtype 13, which gives the long name that corresponds
1513    to each short name.  Modifies variable names in DICT accordingly.  */
1514 static void
1515 parse_long_var_name_map (struct sfm_reader *r,
1516                          const struct sfm_extension_record *record,
1517                          struct dictionary *dict)
1518 {
1519   struct text_record *text;
1520   struct variable *var;
1521   char *long_name;
1522
1523   if (record == NULL)
1524     {
1525       /* Convert variable names to lowercase. */
1526       size_t i;
1527
1528       for (i = 0; i < dict_get_var_cnt (dict); i++)
1529         {
1530           struct variable *var = dict_get_var (dict, i);
1531           char *new_name;
1532
1533           new_name = xstrdup (var_get_name (var));
1534           str_lowercase (new_name);
1535
1536           rename_var_and_save_short_names (dict, var, new_name);
1537
1538           free (new_name);
1539         }
1540
1541       return;
1542     }
1543
1544   /* Rename each of the variables, one by one.  (In a correctly constructed
1545      system file, this cannot create any intermediate duplicate variable names,
1546      because all of the new variable names are longer than any of the old
1547      variable names and thus there cannot be any overlaps.) */
1548   text = open_text_record (r, record, true);
1549   while (read_variable_to_value_pair (r, dict, text, &var, &long_name))
1550     {
1551       /* Validate long name. */
1552       /* XXX need to reencode name to UTF-8 */
1553       if (!dict_id_is_valid (dict, long_name, false))
1554         {
1555           sys_warn (r, record->pos,
1556                     _("Long variable mapping from %s to invalid "
1557                       "variable name `%s'."),
1558                     var_get_name (var), long_name);
1559           continue;
1560         }
1561
1562       /* Identify any duplicates. */
1563       if (strcasecmp (var_get_short_name (var, 0), long_name)
1564           && dict_lookup_var (dict, long_name) != NULL)
1565         {
1566           sys_warn (r, record->pos,
1567                     _("Duplicate long variable name `%s'."), long_name);
1568           continue;
1569         }
1570
1571       rename_var_and_save_short_names (dict, var, long_name);
1572     }
1573   close_text_record (r, text);
1574 }
1575
1576 /* Reads record type 7, subtype 14, which gives the real length
1577    of each very long string.  Rearranges DICT accordingly. */
1578 static void
1579 parse_long_string_map (struct sfm_reader *r,
1580                        const struct sfm_extension_record *record,
1581                        struct dictionary *dict)
1582 {
1583   struct text_record *text;
1584   struct variable *var;
1585   char *length_s;
1586
1587   text = open_text_record (r, record, true);
1588   while (read_variable_to_value_pair (r, dict, text, &var, &length_s))
1589     {
1590       size_t idx = var_get_dict_index (var);
1591       long int length;
1592       int segment_cnt;
1593       int i;
1594
1595       /* Get length. */
1596       length = strtol (length_s, NULL, 10);
1597       if (length < 1 || length > MAX_STRING)
1598         {
1599           sys_warn (r, record->pos,
1600                     _("%s listed as string of invalid length %s "
1601                       "in very long string record."),
1602                     var_get_name (var), length_s);
1603           continue;
1604         }
1605
1606       /* Check segments. */
1607       segment_cnt = sfm_width_to_segments (length);
1608       if (segment_cnt == 1)
1609         {
1610           sys_warn (r, record->pos,
1611                     _("%s listed in very long string record with width %s, "
1612                       "which requires only one segment."),
1613                     var_get_name (var), length_s);
1614           continue;
1615         }
1616       if (idx + segment_cnt > dict_get_var_cnt (dict))
1617         sys_error (r, record->pos,
1618                    _("Very long string %s overflows dictionary."),
1619                    var_get_name (var));
1620
1621       /* Get the short names from the segments and check their
1622          lengths. */
1623       for (i = 0; i < segment_cnt; i++)
1624         {
1625           struct variable *seg = dict_get_var (dict, idx + i);
1626           int alloc_width = sfm_segment_alloc_width (length, i);
1627           int width = var_get_width (seg);
1628
1629           if (i > 0)
1630             var_set_short_name (var, i, var_get_short_name (seg, 0));
1631           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
1632             sys_error (r, record->pos,
1633                        _("Very long string with width %ld has segment %d "
1634                          "of width %d (expected %d)."),
1635                        length, i, width, alloc_width);
1636         }
1637       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1638       var_set_width (var, length);
1639     }
1640   close_text_record (r, text);
1641   dict_compact_values (dict);
1642 }
1643
1644 static void
1645 parse_value_labels (struct sfm_reader *r, struct dictionary *dict,
1646                     const struct sfm_var_record *var_recs, size_t n_var_recs,
1647                     const struct sfm_value_label_record *record)
1648 {
1649   struct variable **vars;
1650   char **utf8_labels;
1651   size_t i;
1652
1653   utf8_labels = pool_nmalloc (r->pool, sizeof *utf8_labels, record->n_labels);
1654   for (i = 0; i < record->n_labels; i++)
1655     utf8_labels[i] = recode_string_pool ("UTF-8", dict_get_encoding (dict),
1656                                          record->labels[i].label, -1,
1657                                          r->pool);
1658
1659   vars = pool_nmalloc (r->pool, record->n_vars, sizeof *vars);
1660   for (i = 0; i < record->n_vars; i++)
1661     vars[i] = lookup_var_by_index (r, record->pos,
1662                                    var_recs, n_var_recs, record->vars[i]);
1663
1664   for (i = 1; i < record->n_vars; i++)
1665     if (var_get_type (vars[i]) != var_get_type (vars[0]))
1666       sys_error (r, record->pos,
1667                  _("Variables associated with value label are not all of "
1668                    "identical type.  Variable %s is %s, but variable "
1669                    "%s is %s."),
1670                  var_get_name (vars[0]),
1671                  var_is_numeric (vars[0]) ? _("numeric") : _("string"),
1672                  var_get_name (vars[i]),
1673                  var_is_numeric (vars[i]) ? _("numeric") : _("string"));
1674
1675   for (i = 0; i < record->n_vars; i++)
1676     {
1677       struct variable *var = vars[i];
1678       int width;
1679       size_t j;
1680
1681       width = var_get_width (var);
1682       if (width > 8)
1683         sys_error (r, record->pos,
1684                    _("Value labels may not be added to long string "
1685                      "variables (e.g. %s) using records types 3 and 4."),
1686                    var_get_name (var));
1687
1688       for (j = 0; j < record->n_labels; j++)
1689         {
1690           struct sfm_value_label *label = &record->labels[j];
1691           union value value;
1692
1693           value_init (&value, width);
1694           if (width == 0)
1695             value.f = parse_float (r, label->value, 0);
1696           else
1697             memcpy (value_str_rw (&value, width), label->value, width);
1698
1699           if (!var_add_value_label (var, &value, utf8_labels[j]))
1700             {
1701               if (var_is_numeric (var))
1702                 sys_warn (r, record->pos,
1703                           _("Duplicate value label for %g on %s."),
1704                           value.f, var_get_name (var));
1705               else
1706                 sys_warn (r, record->pos,
1707                           _("Duplicate value label for `%.*s' on %s."),
1708                           width, value_str (&value, width),
1709                           var_get_name (var));
1710             }
1711
1712           value_destroy (&value, width);
1713         }
1714     }
1715
1716   pool_free (r->pool, vars);
1717   for (i = 0; i < record->n_labels; i++)
1718     pool_free (r->pool, utf8_labels[i]);
1719   pool_free (r->pool, utf8_labels);
1720 }
1721
1722 static struct variable *
1723 lookup_var_by_index (struct sfm_reader *r, off_t offset,
1724                      const struct sfm_var_record *var_recs, size_t n_var_recs,
1725                      int idx)
1726 {
1727   const struct sfm_var_record *rec;
1728
1729   if (idx < 1 || idx > n_var_recs)
1730     {
1731       sys_error (r, offset,
1732                  _("Variable index %d not in valid range 1...%d."),
1733                  idx, n_var_recs);
1734       return NULL;
1735     }
1736
1737   rec = &var_recs[idx - 1];
1738   if (rec->var == NULL)
1739     {
1740       sys_error (r, offset,
1741                  _("Variable index %d refers to long string continuation."),
1742                  idx);
1743       return NULL;
1744     }
1745
1746   return rec->var;
1747 }
1748
1749 /* Parses a set of custom attributes from TEXT into ATTRS.
1750    ATTRS may be a null pointer, in which case the attributes are
1751    read but discarded. */
1752 static void
1753 parse_attributes (struct sfm_reader *r, struct text_record *text,
1754                   struct attrset *attrs)
1755 {
1756   do
1757     {
1758       struct attribute *attr;
1759       char *key;
1760       int index;
1761
1762       /* Parse the key. */
1763       key = text_get_token (text, ss_cstr ("("), NULL);
1764       if (key == NULL)
1765         return;
1766
1767       attr = attribute_create (key);
1768       for (index = 1; ; index++)
1769         {
1770           /* Parse the value. */
1771           char *value;
1772           size_t length;
1773
1774           value = text_get_token (text, ss_cstr ("\n"), NULL);
1775           if (value == NULL)
1776             {
1777               text_warn (r, text, _("Error parsing attribute value %s[%d]."),
1778                          key, index);
1779               break;
1780             }
1781
1782           length = strlen (value);
1783           if (length >= 2 && value[0] == '\'' && value[length - 1] == '\'')
1784             {
1785               value[length - 1] = '\0';
1786               attribute_add_value (attr, value + 1);
1787             }
1788           else
1789             {
1790               text_warn (r, text,
1791                          _("Attribute value %s[%d] is not quoted: %s."),
1792                          key, index, value);
1793               attribute_add_value (attr, value);
1794             }
1795
1796           /* Was this the last value for this attribute? */
1797           if (text_match (text, ')'))
1798             break;
1799         }
1800       if (attrs != NULL)
1801         attrset_add (attrs, attr);
1802       else
1803         attribute_destroy (attr);
1804     }
1805   while (!text_match (text, '/'));
1806 }
1807
1808 /* Reads record type 7, subtype 17, which lists custom
1809    attributes on the data file.  */
1810 static void
1811 parse_data_file_attributes (struct sfm_reader *r,
1812                             const struct sfm_extension_record *record,
1813                             struct dictionary *dict)
1814 {
1815   struct text_record *text = open_text_record (r, record, true);
1816   parse_attributes (r, text, dict_get_attributes (dict));
1817   close_text_record (r, text);
1818 }
1819
1820 /* Parses record type 7, subtype 18, which lists custom
1821    attributes on individual variables.  */
1822 static void
1823 parse_variable_attributes (struct sfm_reader *r,
1824                            const struct sfm_extension_record *record,
1825                            struct dictionary *dict)
1826 {
1827   struct text_record *text;
1828   struct variable *var;
1829
1830   text = open_text_record (r, record, true);
1831   while (text_read_variable_name (r, dict, text, ss_cstr (":"), &var))
1832     parse_attributes (r, text, var != NULL ? var_get_attributes (var) : NULL);
1833   close_text_record (r, text);
1834 }
1835
1836 static void
1837 check_overflow (struct sfm_reader *r,
1838                 const struct sfm_extension_record *record,
1839                 size_t ofs, size_t length)
1840 {
1841   size_t end = record->size * record->count;
1842   if (length >= end || ofs + length > end)
1843     sys_error (r, record->pos + end,
1844                _("Long string value label record ends unexpectedly."));
1845 }
1846
1847 static void
1848 parse_long_string_value_labels (struct sfm_reader *r,
1849                                 const struct sfm_extension_record *record,
1850                                 struct dictionary *dict)
1851 {
1852   const char *dict_encoding = dict_get_encoding (dict);
1853   size_t end = record->size * record->count;
1854   size_t ofs = 0;
1855
1856   while (ofs < end)
1857     {
1858       char *var_name;
1859       size_t n_labels, i;
1860       struct variable *var;
1861       union value value;
1862       int var_name_len;
1863       int width;
1864
1865       /* Parse variable name length. */
1866       check_overflow (r, record, ofs, 4);
1867       var_name_len = parse_int (r, record->data, ofs);
1868       ofs += 4;
1869
1870       /* Parse variable name, width, and number of labels. */
1871       check_overflow (r, record, ofs, var_name_len + 8);
1872       var_name = recode_string_pool ("UTF-8", dict_encoding,
1873                                      (const char *) record->data + ofs,
1874                                      var_name_len, r->pool);
1875       width = parse_int (r, record->data, ofs + var_name_len);
1876       n_labels = parse_int (r, record->data, ofs + var_name_len + 4);
1877       ofs += var_name_len + 8;
1878
1879       /* Look up 'var' and validate. */
1880       var = dict_lookup_var (dict, var_name);
1881       if (var == NULL)
1882         sys_warn (r, record->pos + ofs,
1883                   _("Ignoring long string value record for "
1884                     "unknown variable %s."), var_name);
1885       else if (var_is_numeric (var))
1886         {
1887           sys_warn (r, record->pos + ofs,
1888                     _("Ignoring long string value record for "
1889                       "numeric variable %s."), var_name);
1890           var = NULL;
1891         }
1892       else if (width != var_get_width (var))
1893         {
1894           sys_warn (r, record->pos + ofs,
1895                     _("Ignoring long string value record for variable %s "
1896                       "because the record's width (%d) does not match the "
1897                       "variable's width (%d)."),
1898                     var_name, width, var_get_width (var));
1899           var = NULL;
1900         }
1901
1902       /* Parse values. */
1903       value_init_pool (r->pool, &value, width);
1904       for (i = 0; i < n_labels; i++)
1905         {
1906           size_t value_length, label_length;
1907           bool skip = var == NULL;
1908
1909           /* Parse value length. */
1910           check_overflow (r, record, ofs, 4);
1911           value_length = parse_int (r, record->data, ofs);
1912           ofs += 4;
1913
1914           /* Parse value. */
1915           check_overflow (r, record, ofs, value_length);
1916           if (!skip)
1917             {
1918               if (value_length == width)
1919                 memcpy (value_str_rw (&value, width),
1920                         (const uint8_t *) record->data + ofs, width);
1921               else
1922                 {
1923                   sys_warn (r, record->pos + ofs,
1924                             _("Ignoring long string value %zu for variable "
1925                               "%s, with width %d, that has bad value "
1926                               "width %zu."),
1927                             i, var_get_name (var), width, value_length);
1928                   skip = true;
1929                 }
1930             }
1931           ofs += value_length;
1932
1933           /* Parse label length. */
1934           check_overflow (r, record, ofs, 4);
1935           label_length = parse_int (r, record->data, ofs);
1936           ofs += 4;
1937
1938           /* Parse label. */
1939           check_overflow (r, record, ofs, label_length);
1940           if (!skip)
1941             {
1942               char *label;
1943
1944               label = recode_string_pool ("UTF-8", dict_encoding,
1945                                           (const char *) record->data + ofs,
1946                                           label_length, r->pool);
1947               if (!var_add_value_label (var, &value, label))
1948                 sys_warn (r, record->pos + ofs,
1949                           _("Duplicate value label for `%.*s' on %s."),
1950                           width, value_str (&value, width),
1951                           var_get_name (var));
1952               pool_free (r->pool, label);
1953             }
1954           ofs += label_length;
1955         }
1956     }
1957 }
1958 \f
1959 /* Case reader. */
1960
1961 static void partial_record (struct sfm_reader *r)
1962      NO_RETURN;
1963
1964 static void read_error (struct casereader *, const struct sfm_reader *);
1965
1966 static bool read_case_number (struct sfm_reader *, double *);
1967 static bool read_case_string (struct sfm_reader *, uint8_t *, size_t);
1968 static int read_opcode (struct sfm_reader *);
1969 static bool read_compressed_number (struct sfm_reader *, double *);
1970 static bool read_compressed_string (struct sfm_reader *, uint8_t *);
1971 static bool read_whole_strings (struct sfm_reader *, uint8_t *, size_t);
1972 static bool skip_whole_strings (struct sfm_reader *, size_t);
1973
1974 /* Reads and returns one case from READER's file.  Returns a null
1975    pointer if not successful. */
1976 static struct ccase *
1977 sys_file_casereader_read (struct casereader *reader, void *r_)
1978 {
1979   struct sfm_reader *r = r_;
1980   struct ccase *volatile c;
1981   int i;
1982
1983   if (r->error)
1984     return NULL;
1985
1986   c = case_create (r->proto);
1987   if (setjmp (r->bail_out))
1988     {
1989       casereader_force_error (reader);
1990       case_unref (c);
1991       return NULL;
1992     }
1993
1994   for (i = 0; i < r->sfm_var_cnt; i++)
1995     {
1996       struct sfm_var *sv = &r->sfm_vars[i];
1997       union value *v = case_data_rw_idx (c, sv->case_index);
1998
1999       if (sv->var_width == 0)
2000         {
2001           if (!read_case_number (r, &v->f))
2002             goto eof;
2003         }
2004       else
2005         {
2006           uint8_t *s = value_str_rw (v, sv->var_width);
2007           if (!read_case_string (r, s + sv->offset, sv->segment_width))
2008             goto eof;
2009           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
2010             partial_record (r);
2011         }
2012     }
2013   return c;
2014
2015 eof:
2016   if (i != 0)
2017     partial_record (r);
2018   if (r->case_cnt != -1)
2019     read_error (reader, r);
2020   case_unref (c);
2021   return NULL;
2022 }
2023
2024 /* Issues an error that R ends in a partial record. */
2025 static void
2026 partial_record (struct sfm_reader *r)
2027 {
2028   sys_error (r, r->pos, _("File ends in partial case."));
2029 }
2030
2031 /* Issues an error that an unspecified error occurred SFM, and
2032    marks R tainted. */
2033 static void
2034 read_error (struct casereader *r, const struct sfm_reader *sfm)
2035 {
2036   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
2037   casereader_force_error (r);
2038 }
2039
2040 /* Reads a number from R and stores its value in *D.
2041    If R is compressed, reads a compressed number;
2042    otherwise, reads a number in the regular way.
2043    Returns true if successful, false if end of file is
2044    reached immediately. */
2045 static bool
2046 read_case_number (struct sfm_reader *r, double *d)
2047 {
2048   if (!r->compressed)
2049     {
2050       uint8_t number[8];
2051       if (!try_read_bytes (r, number, sizeof number))
2052         return false;
2053       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
2054       return true;
2055     }
2056   else
2057     return read_compressed_number (r, d);
2058 }
2059
2060 /* Reads LENGTH string bytes from R into S.
2061    Always reads a multiple of 8 bytes; if LENGTH is not a
2062    multiple of 8, then extra bytes are read and discarded without
2063    being written to S.
2064    Reads compressed strings if S is compressed.
2065    Returns true if successful, false if end of file is
2066    reached immediately. */
2067 static bool
2068 read_case_string (struct sfm_reader *r, uint8_t *s, size_t length)
2069 {
2070   size_t whole = ROUND_DOWN (length, 8);
2071   size_t partial = length % 8;
2072
2073   if (whole)
2074     {
2075       if (!read_whole_strings (r, s, whole))
2076         return false;
2077     }
2078
2079   if (partial)
2080     {
2081       uint8_t bounce[8];
2082       if (!read_whole_strings (r, bounce, sizeof bounce))
2083         {
2084           if (whole)
2085             partial_record (r);
2086           return false;
2087         }
2088       memcpy (s + whole, bounce, partial);
2089     }
2090
2091   return true;
2092 }
2093
2094 /* Reads and returns the next compression opcode from R. */
2095 static int
2096 read_opcode (struct sfm_reader *r)
2097 {
2098   assert (r->compressed);
2099   for (;;)
2100     {
2101       int opcode;
2102       if (r->opcode_idx >= sizeof r->opcodes)
2103         {
2104           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
2105             return -1;
2106           r->opcode_idx = 0;
2107         }
2108       opcode = r->opcodes[r->opcode_idx++];
2109
2110       if (opcode != 0)
2111         return opcode;
2112     }
2113 }
2114
2115 /* Reads a compressed number from R and stores its value in D.
2116    Returns true if successful, false if end of file is
2117    reached immediately. */
2118 static bool
2119 read_compressed_number (struct sfm_reader *r, double *d)
2120 {
2121   int opcode = read_opcode (r);
2122   switch (opcode)
2123     {
2124     case -1:
2125     case 252:
2126       return false;
2127
2128     case 253:
2129       *d = read_float (r);
2130       break;
2131
2132     case 254:
2133       float_convert (r->float_format, "        ", FLOAT_NATIVE_DOUBLE, d);
2134       if (!r->corruption_warning)
2135         {
2136           r->corruption_warning = true;
2137           sys_warn (r, r->pos,
2138                     _("Possible compressed data corruption: "
2139                       "compressed spaces appear in numeric field."));
2140         }
2141       break;
2142
2143     case 255:
2144       *d = SYSMIS;
2145       break;
2146
2147     default:
2148       *d = opcode - r->bias;
2149       break;
2150     }
2151
2152   return true;
2153 }
2154
2155 /* Reads a compressed 8-byte string segment from R and stores it
2156    in DST.
2157    Returns true if successful, false if end of file is
2158    reached immediately. */
2159 static bool
2160 read_compressed_string (struct sfm_reader *r, uint8_t *dst)
2161 {
2162   int opcode = read_opcode (r);
2163   switch (opcode)
2164     {
2165     case -1:
2166     case 252:
2167       return false;
2168
2169     case 253:
2170       read_bytes (r, dst, 8);
2171       break;
2172
2173     case 254:
2174       memset (dst, ' ', 8);
2175       break;
2176
2177     default:
2178       {
2179         double value = opcode - r->bias;
2180         float_convert (FLOAT_NATIVE_DOUBLE, &value, r->float_format, dst);
2181         if (value == 0.0)
2182           {
2183             /* This has actually been seen "in the wild".  The submitter of the
2184                file that showed that the contents decoded as spaces, but they
2185                were at the end of the field so it's possible that the null
2186                bytes just acted as null terminators. */
2187           }
2188         else if (!r->corruption_warning)
2189           {
2190             r->corruption_warning = true;
2191             sys_warn (r, r->pos,
2192                       _("Possible compressed data corruption: "
2193                         "string contains compressed integer (opcode %d)."),
2194                       opcode);
2195           }
2196       }
2197       break;
2198     }
2199
2200   return true;
2201 }
2202
2203 /* Reads LENGTH string bytes from R into S.
2204    LENGTH must be a multiple of 8.
2205    Reads compressed strings if S is compressed.
2206    Returns true if successful, false if end of file is
2207    reached immediately. */
2208 static bool
2209 read_whole_strings (struct sfm_reader *r, uint8_t *s, size_t length)
2210 {
2211   assert (length % 8 == 0);
2212   if (!r->compressed)
2213     return try_read_bytes (r, s, length);
2214   else
2215     {
2216       size_t ofs;
2217       for (ofs = 0; ofs < length; ofs += 8)
2218         if (!read_compressed_string (r, s + ofs))
2219           {
2220             if (ofs != 0)
2221               partial_record (r);
2222             return false;
2223           }
2224       return true;
2225     }
2226 }
2227
2228 /* Skips LENGTH string bytes from R.
2229    LENGTH must be a multiple of 8.
2230    (LENGTH is also limited to 1024, but that's only because the
2231    current caller never needs more than that many bytes.)
2232    Returns true if successful, false if end of file is
2233    reached immediately. */
2234 static bool
2235 skip_whole_strings (struct sfm_reader *r, size_t length)
2236 {
2237   uint8_t buffer[1024];
2238   assert (length < sizeof buffer);
2239   return read_whole_strings (r, buffer, length);
2240 }
2241 \f
2242 /* Helpers for reading records that contain structured text
2243    strings. */
2244
2245 /* Maximum number of warnings to issue for a single text
2246    record. */
2247 #define MAX_TEXT_WARNINGS 5
2248
2249 /* State. */
2250 struct text_record
2251   {
2252     struct substring buffer;    /* Record contents. */
2253     off_t start;                /* Starting offset in file. */
2254     size_t pos;                 /* Current position in buffer. */
2255     int n_warnings;             /* Number of warnings issued or suppressed. */
2256     bool recoded;               /* Recoded into UTF-8? */
2257   };
2258
2259 static struct text_record *
2260 open_text_record (struct sfm_reader *r,
2261                   const struct sfm_extension_record *record,
2262                   bool recode_to_utf8)
2263 {
2264   struct text_record *text;
2265   struct substring raw;
2266
2267   text = pool_alloc (r->pool, sizeof *text);
2268   raw = ss_buffer (record->data, record->size * record->count);
2269   text->start = record->pos;
2270   text->buffer = (recode_to_utf8
2271                   ? recode_substring_pool ("UTF-8", r->encoding, raw, r->pool)
2272                   : raw);
2273   text->pos = 0;
2274   text->n_warnings = 0;
2275   text->recoded = recode_to_utf8;
2276
2277   return text;
2278 }
2279
2280 /* Closes TEXT, frees its storage, and issues a final warning
2281    about suppressed warnings if necesary. */
2282 static void
2283 close_text_record (struct sfm_reader *r, struct text_record *text)
2284 {
2285   if (text->n_warnings > MAX_TEXT_WARNINGS)
2286     sys_warn (r, -1, _("Suppressed %d additional related warnings."),
2287               text->n_warnings - MAX_TEXT_WARNINGS);
2288   if (text->recoded)
2289     pool_free (r->pool, ss_data (text->buffer));
2290 }
2291
2292 /* Reads a variable=value pair from TEXT.
2293    Looks up the variable in DICT and stores it into *VAR.
2294    Stores a null-terminated value into *VALUE. */
2295 static bool
2296 read_variable_to_value_pair (struct sfm_reader *r, struct dictionary *dict,
2297                              struct text_record *text,
2298                              struct variable **var, char **value)
2299 {
2300   for (;;)
2301     {
2302       if (!text_read_short_name (r, dict, text, ss_cstr ("="), var))
2303         return false;
2304
2305       *value = text_get_token (text, ss_buffer ("\t\0", 2), NULL);
2306       if (*value == NULL)
2307         return false;
2308
2309       text->pos += ss_span (ss_substr (text->buffer, text->pos, SIZE_MAX),
2310                             ss_buffer ("\t\0", 2));
2311
2312       if (*var != NULL)
2313         return true;
2314     }
2315 }
2316
2317 static bool
2318 text_read_variable_name (struct sfm_reader *r, struct dictionary *dict,
2319                          struct text_record *text, struct substring delimiters,
2320                          struct variable **var)
2321 {
2322   char *name;
2323
2324   name = text_get_token (text, delimiters, NULL);
2325   if (name == NULL)
2326     return false;
2327
2328   *var = dict_lookup_var (dict, name);
2329   if (*var != NULL)
2330     return true;
2331
2332   text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2333              name);
2334   return false;
2335 }
2336
2337
2338 static bool
2339 text_read_short_name (struct sfm_reader *r, struct dictionary *dict,
2340                       struct text_record *text, struct substring delimiters,
2341                       struct variable **var)
2342 {
2343   char *short_name = text_get_token (text, delimiters, NULL);
2344   if (short_name == NULL)
2345     return false;
2346
2347   *var = dict_lookup_var (dict, short_name);
2348   if (*var == NULL)
2349     text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2350                short_name);
2351   return true;
2352 }
2353
2354 /* Displays a warning for the current file position, limiting the
2355    number to MAX_TEXT_WARNINGS for TEXT. */
2356 static void
2357 text_warn (struct sfm_reader *r, struct text_record *text,
2358            const char *format, ...)
2359 {
2360   if (text->n_warnings++ < MAX_TEXT_WARNINGS)
2361     {
2362       va_list args;
2363
2364       va_start (args, format);
2365       sys_msg (r, text->start + text->pos, MW, format, args);
2366       va_end (args);
2367     }
2368 }
2369
2370 static char *
2371 text_get_token (struct text_record *text, struct substring delimiters,
2372                 char *delimiter)
2373 {
2374   struct substring token;
2375   char *end;
2376
2377   if (!ss_tokenize (text->buffer, delimiters, &text->pos, &token))
2378     return NULL;
2379
2380   end = &ss_data (token)[ss_length (token)];
2381   if (delimiter != NULL)
2382     *delimiter = *end;
2383   *end = '\0';
2384   return ss_data (token);
2385 }
2386
2387 /* Reads a integer value expressed in decimal, then a space, then a string that
2388    consists of exactly as many bytes as specified by the integer, then a space,
2389    from TEXT.  Returns the string, null-terminated, as a subset of TEXT's
2390    buffer (so the caller should not free the string). */
2391 static const char *
2392 text_parse_counted_string (struct sfm_reader *r, struct text_record *text)
2393 {
2394   size_t start;
2395   size_t n;
2396   char *s;
2397
2398   start = text->pos;
2399   n = 0;
2400   for (;;)
2401     {
2402       int c = text->buffer.string[text->pos];
2403       if (c < '0' || c > '9')
2404         break;
2405       n = (n * 10) + (c - '0');
2406       text->pos++;
2407     }
2408   if (start == text->pos)
2409     {
2410       sys_warn (r, text->start,
2411                 _("Expecting digit at offset %zu in MRSETS record."),
2412                 text->pos);
2413       return NULL;
2414     }
2415
2416   if (!text_match (text, ' '))
2417     {
2418       sys_warn (r, text->start,
2419                 _("Expecting space at offset %zu in MRSETS record."),
2420                 text->pos);
2421       return NULL;
2422     }
2423
2424   if (text->pos + n > text->buffer.length)
2425     {
2426       sys_warn (r, text->start,
2427                 _("%zu-byte string starting at offset %zu "
2428                   "exceeds record length %zu."),
2429                 n, text->pos, text->buffer.length);
2430       return NULL;
2431     }
2432
2433   s = &text->buffer.string[text->pos];
2434   if (s[n] != ' ')
2435     {
2436       sys_warn (r, text->start,
2437                 _("Expecting space at offset %zu following %zu-byte string."),
2438                 text->pos + n, n);
2439       return NULL;
2440     }
2441   s[n] = '\0';
2442   text->pos += n + 1;
2443   return s;
2444 }
2445
2446 static bool
2447 text_match (struct text_record *text, char c)
2448 {
2449   if (text->buffer.string[text->pos] == c)
2450     {
2451       text->pos++;
2452       return true;
2453     }
2454   else
2455     return false;
2456 }
2457
2458 /* Returns the current byte offset (as converted to UTF-8, if it was converted)
2459    inside the TEXT's string. */
2460 static size_t
2461 text_pos (const struct text_record *text)
2462 {
2463   return text->pos;
2464 }
2465 \f
2466 /* Messages. */
2467
2468 /* Displays a corruption message. */
2469 static void
2470 sys_msg (struct sfm_reader *r, off_t offset,
2471          int class, const char *format, va_list args)
2472 {
2473   struct msg m;
2474   struct string text;
2475
2476   ds_init_empty (&text);
2477   if (offset >= 0)
2478     ds_put_format (&text, _("`%s' near offset 0x%llx: "),
2479                    fh_get_file_name (r->fh), (long long int) offset);
2480   else
2481     ds_put_format (&text, _("`%s': "), fh_get_file_name (r->fh));
2482   ds_put_vformat (&text, format, args);
2483
2484   m.category = msg_class_to_category (class);
2485   m.severity = msg_class_to_severity (class);
2486   m.file_name = NULL;
2487   m.first_line = 0;
2488   m.last_line = 0;
2489   m.first_column = 0;
2490   m.last_column = 0;
2491   m.text = ds_cstr (&text);
2492
2493   msg_emit (&m);
2494 }
2495
2496 /* Displays a warning for offset OFFSET in the file. */
2497 static void
2498 sys_warn (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, MW, format, args);
2504   va_end (args);
2505 }
2506
2507 /* Displays an error for the current file position,
2508    marks it as in an error state,
2509    and aborts reading it using longjmp. */
2510 static void
2511 sys_error (struct sfm_reader *r, off_t offset, const char *format, ...)
2512 {
2513   va_list args;
2514
2515   va_start (args, format);
2516   sys_msg (r, offset, ME, format, args);
2517   va_end (args);
2518
2519   r->error = true;
2520   longjmp (r->bail_out, 1);
2521 }
2522 \f
2523 /* Reads BYTE_CNT bytes into BUF.
2524    Returns true if exactly BYTE_CNT bytes are successfully read.
2525    Aborts if an I/O error or a partial read occurs.
2526    If EOF_IS_OK, then an immediate end-of-file causes false to be
2527    returned; otherwise, immediate end-of-file causes an abort
2528    too. */
2529 static inline bool
2530 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
2531                    void *buf, size_t byte_cnt)
2532 {
2533   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
2534   r->pos += bytes_read;
2535   if (bytes_read == byte_cnt)
2536     return true;
2537   else if (ferror (r->file))
2538     sys_error (r, r->pos, _("System error: %s."), strerror (errno));
2539   else if (!eof_is_ok || bytes_read != 0)
2540     sys_error (r, r->pos, _("Unexpected end of file."));
2541   else
2542     return false;
2543 }
2544
2545 /* Reads BYTE_CNT into BUF.
2546    Aborts upon I/O error or if end-of-file is encountered. */
2547 static void
2548 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2549 {
2550   read_bytes_internal (r, false, buf, byte_cnt);
2551 }
2552
2553 /* Reads BYTE_CNT bytes into BUF.
2554    Returns true if exactly BYTE_CNT bytes are successfully read.
2555    Returns false if an immediate end-of-file is encountered.
2556    Aborts if an I/O error or a partial read occurs. */
2557 static bool
2558 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2559 {
2560   return read_bytes_internal (r, true, buf, byte_cnt);
2561 }
2562
2563 /* Reads a 32-bit signed integer from R and returns its value in
2564    host format. */
2565 static int
2566 read_int (struct sfm_reader *r)
2567 {
2568   uint8_t integer[4];
2569   read_bytes (r, integer, sizeof integer);
2570   return integer_get (r->integer_format, integer, sizeof integer);
2571 }
2572
2573 /* Reads a 64-bit floating-point number from R and returns its
2574    value in host format. */
2575 static double
2576 read_float (struct sfm_reader *r)
2577 {
2578   uint8_t number[8];
2579   read_bytes (r, number, sizeof number);
2580   return float_get_double (r->float_format, number);
2581 }
2582
2583 static int
2584 parse_int (struct sfm_reader *r, const void *data, size_t ofs)
2585 {
2586   return integer_get (r->integer_format, (const uint8_t *) data + ofs, 4);
2587 }
2588
2589 static double
2590 parse_float (struct sfm_reader *r, const void *data, size_t ofs)
2591 {
2592   return float_get_double (r->float_format, (const uint8_t *) data + ofs);
2593 }
2594
2595 /* Reads exactly SIZE - 1 bytes into BUFFER
2596    and stores a null byte into BUFFER[SIZE - 1]. */
2597 static void
2598 read_string (struct sfm_reader *r, char *buffer, size_t size)
2599 {
2600   assert (size > 0);
2601   read_bytes (r, buffer, size - 1);
2602   buffer[size - 1] = '\0';
2603 }
2604
2605 /* Skips BYTES bytes forward in R. */
2606 static void
2607 skip_bytes (struct sfm_reader *r, size_t bytes)
2608 {
2609   while (bytes > 0)
2610     {
2611       char buffer[1024];
2612       size_t chunk = MIN (sizeof buffer, bytes);
2613       read_bytes (r, buffer, chunk);
2614       bytes -= chunk;
2615     }
2616 }
2617 \f
2618 static const struct casereader_class sys_file_casereader_class =
2619   {
2620     sys_file_casereader_read,
2621     sys_file_casereader_destroy,
2622     NULL,
2623     NULL,
2624   };