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