src/data/sys-file-reader.c

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