src/data/sys-file-reader.c

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