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