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