CORRELATIONS: Fixed bug displaying non-sqaure correlation matrices
[pspp] / src / data / sys-file-reader.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-2000, 2006-2007, 2009-2012 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 "data/attributes.h"
29 #include "data/case.h"
30 #include "data/casereader-provider.h"
31 #include "data/casereader.h"
32 #include "data/dictionary.h"
33 #include "data/file-handle-def.h"
34 #include "data/file-name.h"
35 #include "data/format.h"
36 #include "data/identifier.h"
37 #include "data/missing-values.h"
38 #include "data/mrset.h"
39 #include "data/short-names.h"
40 #include "data/value-labels.h"
41 #include "data/value.h"
42 #include "data/variable.h"
43 #include "libpspp/array.h"
44 #include "libpspp/assertion.h"
45 #include "libpspp/compiler.h"
46 #include "libpspp/i18n.h"
47 #include "libpspp/message.h"
48 #include "libpspp/misc.h"
49 #include "libpspp/pool.h"
50 #include "libpspp/str.h"
51 #include "libpspp/stringi-set.h"
52
53 #include "gl/c-ctype.h"
54 #include "gl/inttostr.h"
55 #include "gl/localcharset.h"
56 #include "gl/minmax.h"
57 #include "gl/unlocked-io.h"
58 #include "gl/xalloc.h"
59 #include "gl/xsize.h"
60
61 #include "gettext.h"
62 #define _(msgid) gettext (msgid)
63 #define N_(msgid) (msgid)
64
65 enum
66   {
67     /* subtypes 0-2 unknown */
68     EXT_INTEGER       = 3,      /* Machine integer info. */
69     EXT_FLOAT         = 4,      /* Machine floating-point info. */
70     EXT_VAR_SETS      = 5,      /* Variable sets. */
71     EXT_DATE          = 6,      /* DATE. */
72     EXT_MRSETS        = 7,      /* Multiple response sets. */
73     EXT_DATA_ENTRY    = 8,      /* SPSS Data Entry. */
74     /* subtypes 9-10 unknown */
75     EXT_DISPLAY       = 11,     /* Variable display parameters. */
76     /* subtype 12 unknown */
77     EXT_LONG_NAMES    = 13,     /* Long variable names. */
78     EXT_LONG_STRINGS  = 14,     /* Long strings. */
79     /* subtype 15 unknown */
80     EXT_NCASES        = 16,     /* Extended number of cases. */
81     EXT_FILE_ATTRS    = 17,     /* Data file attributes. */
82     EXT_VAR_ATTRS     = 18,     /* Variable attributes. */
83     EXT_MRSETS2       = 19,     /* Multiple response sets (extended). */
84     EXT_ENCODING      = 20,     /* Character encoding. */
85     EXT_LONG_LABELS   = 21      /* Value labels for long strings. */
86   };
87
88 /* Fields from the top-level header record. */
89 struct sfm_header_record
90   {
91     char magic[5];              /* First 4 bytes of file, then null. */
92     int weight_idx;             /* 0 if unweighted, otherwise a var index. */
93     int nominal_case_size;      /* Number of var positions. */
94
95     /* These correspond to the members of struct sfm_file_info or a dictionary
96        but in the system file's encoding rather than ASCII. */
97     char creation_date[10];     /* "dd mmm yy". */
98     char creation_time[9];      /* "hh:mm:ss". */
99     char eye_catcher[61];       /* Eye-catcher string, then product name. */
100     char file_label[65];        /* File label. */
101   };
102
103 struct sfm_var_record
104   {
105     off_t pos;
106     int width;
107     char name[8];
108     int print_format;
109     int write_format;
110     int missing_value_code;
111     uint8_t missing[24];
112     char *label;
113     struct variable *var;
114   };
115
116 struct sfm_value_label
117   {
118     uint8_t value[8];
119     char *label;
120   };
121
122 struct sfm_value_label_record
123   {
124     off_t pos;
125     struct sfm_value_label *labels;
126     size_t n_labels;
127
128     int *vars;
129     size_t n_vars;
130   };
131
132 struct sfm_document_record
133   {
134     off_t pos;
135     char *documents;
136     size_t n_lines;
137   };
138
139 struct sfm_extension_record
140   {
141     off_t pos;                  /* Starting offset in file. */
142     size_t size;                /* Size of data elements. */
143     size_t count;               /* Number of data elements. */
144     void *data;                 /* Contents. */
145   };
146
147 /* System file reader. */
148 struct sfm_reader
149   {
150     /* Resource tracking. */
151     struct pool *pool;          /* All system file state. */
152     jmp_buf bail_out;           /* longjmp() target for error handling. */
153
154     /* File state. */
155     struct file_handle *fh;     /* File handle. */
156     struct fh_lock *lock;       /* Mutual exclusion for file handle. */
157     FILE *file;                 /* File stream. */
158     off_t pos;                  /* Position in file. */
159     bool error;                 /* I/O or corruption error? */
160     struct caseproto *proto;    /* Format of output cases. */
161
162     /* File format. */
163     enum integer_format integer_format; /* On-disk integer format. */
164     enum float_format float_format; /* On-disk floating point format. */
165     struct sfm_var *sfm_vars;   /* Variables. */
166     size_t sfm_var_cnt;         /* Number of variables. */
167     casenumber case_cnt;        /* Number of cases */
168     const char *encoding;       /* String encoding. */
169
170     /* Decompression. */
171     bool compressed;            /* File is compressed? */
172     double bias;                /* Compression bias, usually 100.0. */
173     uint8_t opcodes[8];         /* Current block of opcodes. */
174     size_t opcode_idx;          /* Next opcode to interpret, 8 if none left. */
175     bool corruption_warning;    /* Warned about possible corruption? */
176   };
177
178 static const struct casereader_class sys_file_casereader_class;
179
180 static bool close_reader (struct sfm_reader *);
181
182 static struct variable *lookup_var_by_index (struct sfm_reader *, off_t,
183                                              const struct sfm_var_record *,
184                                              size_t n, int idx);
185
186 static void sys_msg (struct sfm_reader *r, off_t, int class,
187                      const char *format, va_list args)
188      PRINTF_FORMAT (4, 0);
189 static void sys_warn (struct sfm_reader *, off_t, const char *, ...)
190      PRINTF_FORMAT (3, 4);
191 static void sys_error (struct sfm_reader *, off_t, const char *, ...)
192      PRINTF_FORMAT (3, 4)
193      NO_RETURN;
194
195 static void read_bytes (struct sfm_reader *, void *, size_t);
196 static bool try_read_bytes (struct sfm_reader *, void *, size_t);
197 static int read_int (struct sfm_reader *);
198 static double read_float (struct sfm_reader *);
199 static void read_string (struct sfm_reader *, char *, size_t);
200 static void skip_bytes (struct sfm_reader *, size_t);
201
202 static int parse_int (struct sfm_reader *, const void *data, size_t ofs);
203 static double parse_float (struct sfm_reader *, const void *data, size_t ofs);
204
205 static void read_variable_record (struct sfm_reader *,
206                                   struct sfm_var_record *);
207 static void read_value_label_record (struct sfm_reader *,
208                                      struct sfm_value_label_record *,
209                                      size_t n_vars);
210 static struct sfm_document_record *read_document_record (struct sfm_reader *);
211 static struct sfm_extension_record *read_extension_record (
212   struct sfm_reader *, int subtype);
213 static void skip_extension_record (struct sfm_reader *, int subtype);
214
215 static const char *choose_encoding (
216   struct sfm_reader *,
217   const struct sfm_header_record *,
218   const struct sfm_extension_record *ext_integer,
219   const struct sfm_extension_record *ext_encoding);
220
221 static struct text_record *open_text_record (
222   struct sfm_reader *, const struct sfm_extension_record *,
223   bool recode_to_utf8);
224 static void close_text_record (struct sfm_reader *,
225                                struct text_record *);
226 static bool read_variable_to_value_pair (struct sfm_reader *,
227                                          struct dictionary *,
228                                          struct text_record *,
229                                          struct variable **var, char **value);
230 static void text_warn (struct sfm_reader *r, struct text_record *text,
231                        const char *format, ...)
232   PRINTF_FORMAT (3, 4);
233 static char *text_get_token (struct text_record *,
234                              struct substring delimiters, char *delimiter);
235 static bool text_match (struct text_record *, char c);
236 static bool text_read_variable_name (struct sfm_reader *, struct dictionary *,
237                                      struct text_record *,
238                                      struct substring delimiters,
239                                      struct variable **);
240 static bool text_read_short_name (struct sfm_reader *, struct dictionary *,
241                                   struct text_record *,
242                                   struct substring delimiters,
243                                   struct variable **);
244 static const char *text_parse_counted_string (struct sfm_reader *,
245                                               struct text_record *);
246 static size_t text_pos (const struct text_record *);
247
248 static bool close_reader (struct sfm_reader *r);
249 \f
250 /* Dictionary reader. */
251
252 enum which_format
253   {
254     PRINT_FORMAT,
255     WRITE_FORMAT
256   };
257
258 static void read_header (struct sfm_reader *, struct sfm_read_info *,
259                          struct sfm_header_record *);
260 static void parse_header (struct sfm_reader *,
261                           const struct sfm_header_record *,
262                           struct sfm_read_info *, struct dictionary *);
263 static void parse_variable_records (struct sfm_reader *, struct dictionary *,
264                                     struct sfm_var_record *, size_t n);
265 static void parse_format_spec (struct sfm_reader *, off_t pos,
266                                unsigned int format, enum which_format,
267                                struct variable *, int *format_warning_cnt);
268 static void parse_document (struct dictionary *, struct sfm_document_record *);
269 static void parse_display_parameters (struct sfm_reader *,
270                                       const struct sfm_extension_record *,
271                                       struct dictionary *);
272 static void parse_machine_integer_info (struct sfm_reader *,
273                                         const struct sfm_extension_record *,
274                                         struct sfm_read_info *);
275 static void parse_machine_float_info (struct sfm_reader *,
276                                       const struct sfm_extension_record *);
277 static void parse_mrsets (struct sfm_reader *,
278                           const struct sfm_extension_record *,
279                           struct dictionary *);
280 static void parse_long_var_name_map (struct sfm_reader *,
281                                      const struct sfm_extension_record *,
282                                      struct dictionary *);
283 static void parse_long_string_map (struct sfm_reader *,
284                                    const struct sfm_extension_record *,
285                                    struct dictionary *);
286 static void parse_value_labels (struct sfm_reader *, struct dictionary *,
287                                 const struct sfm_var_record *,
288                                 size_t n_var_recs,
289                                 const struct sfm_value_label_record *);
290 static void parse_data_file_attributes (struct sfm_reader *,
291                                         const struct sfm_extension_record *,
292                                         struct dictionary *);
293 static void parse_variable_attributes (struct sfm_reader *,
294                                        const struct sfm_extension_record *,
295                                        struct dictionary *);
296 static void parse_long_string_value_labels (struct sfm_reader *,
297                                             const struct sfm_extension_record *,
298                                             struct dictionary *);
299
300 /* Frees the strings inside INFO. */
301 void
302 sfm_read_info_destroy (struct sfm_read_info *info)
303 {
304   if (info)
305     {
306       free (info->creation_date);
307       free (info->creation_time);
308       free (info->product);
309     }
310 }
311
312 /* Opens the system file designated by file handle FH for reading.  Reads the
313    system file's dictionary into *DICT.
314
315    Ordinarily the reader attempts to automatically detect the character
316    encoding based on the file's contents.  This isn't always possible,
317    especially for files written by old versions of SPSS or PSPP, so specifying
318    a nonnull ENCODING overrides the choice of character encoding.
319
320    If INFO is non-null, then it receives additional info about the system file,
321    which the caller must eventually free with sfm_read_info_destroy() when it
322    is no longer needed. */
323 struct casereader *
324 sfm_open_reader (struct file_handle *fh, const char *volatile encoding,
325                  struct dictionary **dictp, struct sfm_read_info *infop)
326 {
327   struct sfm_reader *volatile r = NULL;
328   struct sfm_read_info info;
329
330   struct sfm_header_record header;
331
332   struct sfm_var_record *vars;
333   size_t n_vars, allocated_vars;
334
335   struct sfm_value_label_record *labels;
336   size_t n_labels, allocated_labels;
337
338   struct sfm_document_record *document;
339
340   struct sfm_extension_record *extensions[32];
341
342   struct dictionary *dict = NULL;
343   size_t i;
344
345   /* Create and initialize reader. */
346   r = pool_create_container (struct sfm_reader, pool);
347   r->fh = fh_ref (fh);
348   r->lock = NULL;
349   r->file = NULL;
350   r->pos = 0;
351   r->error = false;
352   r->opcode_idx = sizeof r->opcodes;
353   r->corruption_warning = false;
354
355   memset (&info, 0, sizeof info);
356
357   /* TRANSLATORS: this fragment will be interpolated into
358      messages in fh_lock() that identify types of files. */
359   r->lock = fh_lock (fh, FH_REF_FILE, N_("system file"), FH_ACC_READ, false);
360   if (r->lock == NULL)
361     goto error;
362
363   r->file = fn_open (fh_get_file_name (fh), "rb");
364   if (r->file == NULL)
365     {
366       msg (ME, _("Error opening `%s' for reading as a system file: %s."),
367            fh_get_file_name (r->fh), strerror (errno));
368       goto error;
369     }
370
371   if (setjmp (r->bail_out))
372     goto error;
373
374   /* Read header. */
375   read_header (r, &info, &header);
376
377   vars = NULL;
378   n_vars = allocated_vars = 0;
379
380   labels = NULL;
381   n_labels = allocated_labels = 0;
382
383   document = NULL;
384
385   memset (extensions, 0, sizeof extensions);
386
387   for (;;)
388     {
389       int subtype;
390       int type;
391
392       type = read_int (r);
393       if (type == 999)
394         {
395           read_int (r);         /* Skip filler. */
396           break;
397         }
398
399       switch (type)
400         {
401         case 2:
402           if (n_vars >= allocated_vars)
403             vars = pool_2nrealloc (r->pool, vars, &allocated_vars,
404                                    sizeof *vars);
405           read_variable_record (r, &vars[n_vars++]);
406           break;
407
408         case 3:
409           if (n_labels >= allocated_labels)
410             labels = pool_2nrealloc (r->pool, labels, &allocated_labels,
411                                      sizeof *labels);
412           read_value_label_record (r, &labels[n_labels++], n_vars);
413           break;
414
415         case 4:
416           /* A Type 4 record is always immediately after a type 3 record,
417              so the code for type 3 records reads the type 4 record too. */
418           sys_error (r, r->pos, _("Misplaced type 4 record."));
419
420         case 6:
421           if (document != NULL)
422             sys_error (r, r->pos, _("Duplicate type 6 (document) record."));
423           document = read_document_record (r);
424           break;
425
426         case 7:
427           subtype = read_int (r);
428           if (subtype < 0 || subtype >= sizeof extensions / sizeof *extensions)
429             {
430               sys_warn (r, r->pos,
431                         _("Unrecognized record type 7, subtype %d.  Please "
432                           "send a copy of this file, and the syntax which "
433                           "created it to %s."),
434                         subtype, PACKAGE_BUGREPORT);
435               skip_extension_record (r, subtype);
436             }
437           else if (extensions[subtype] != NULL)
438             {
439               sys_warn (r, r->pos,
440                         _("Record type 7, subtype %d found here has the same "
441                           "type as the record found near offset 0x%llx.  "
442                           "Please send a copy of this file, and the syntax "
443                           "which created it to %s."),
444                         subtype, (long long int) extensions[subtype]->pos,
445                         PACKAGE_BUGREPORT);
446               skip_extension_record (r, subtype);
447             }
448           else
449             extensions[subtype] = read_extension_record (r, subtype);
450           break;
451
452         default:
453           sys_error (r, r->pos, _("Unrecognized record type %d."), type);
454           goto error;
455         }
456     }
457
458   /* Now actually parse what we read.
459
460      First, figure out the correct character encoding, because this determines
461      how the rest of the header data is to be interpreted. */
462   dict = dict_create (encoding
463                       ? encoding
464                       : choose_encoding (r, &header, extensions[EXT_INTEGER],
465                                          extensions[EXT_ENCODING]));
466   r->encoding = dict_get_encoding (dict);
467
468   /* These records don't use variables at all. */
469   if (document != NULL)
470     parse_document (dict, document);
471
472   if (extensions[EXT_INTEGER] != NULL)
473     parse_machine_integer_info (r, extensions[EXT_INTEGER], &info);
474
475   if (extensions[EXT_FLOAT] != NULL)
476     parse_machine_float_info (r, extensions[EXT_FLOAT]);
477
478   if (extensions[EXT_FILE_ATTRS] != NULL)
479     parse_data_file_attributes (r, extensions[EXT_FILE_ATTRS], dict);
480
481   parse_header (r, &header, &info, dict);
482
483   /* Parse the variable records, the basis of almost everything else. */
484   parse_variable_records (r, dict, vars, n_vars);
485
486   /* Parse value labels and the weight variable immediately after the variable
487      records.  These records use indexes into var_recs[], so we must parse them
488      before those indexes become invalidated by very long string variables. */
489   for (i = 0; i < n_labels; i++)
490     parse_value_labels (r, dict, vars, n_vars, &labels[i]);
491   if (header.weight_idx != 0)
492     {
493       struct variable *weight_var;
494
495       weight_var = lookup_var_by_index (r, 76, vars, n_vars,
496                                         header.weight_idx);
497       if (var_is_numeric (weight_var))
498         dict_set_weight (dict, weight_var);
499       else
500         sys_error (r, -1, _("Weighting variable must be numeric "
501                             "(not string variable `%s')."),
502                    var_get_name (weight_var));
503     }
504
505   if (extensions[EXT_DISPLAY] != NULL)
506     parse_display_parameters (r, extensions[EXT_DISPLAY], dict);
507
508   /* The following records use short names, so they need to be parsed before
509      parse_long_var_name_map() changes short names to long names. */
510   if (extensions[EXT_MRSETS] != NULL)
511     parse_mrsets (r, extensions[EXT_MRSETS], dict);
512
513   if (extensions[EXT_MRSETS2] != NULL)
514     parse_mrsets (r, extensions[EXT_MRSETS2], dict);
515
516   if (extensions[EXT_LONG_STRINGS] != NULL)
517     parse_long_string_map (r, extensions[EXT_LONG_STRINGS], dict);
518
519   /* Now rename variables to their long names. */
520   parse_long_var_name_map (r, extensions[EXT_LONG_NAMES], dict);
521
522   /* The following records use long names, so they need to follow renaming. */
523   if (extensions[EXT_VAR_ATTRS] != NULL)
524     parse_variable_attributes (r, extensions[EXT_VAR_ATTRS], dict);
525
526   if (extensions[EXT_LONG_LABELS] != NULL)
527     parse_long_string_value_labels (r, extensions[EXT_LONG_LABELS], dict);
528
529   /* Warn if the actual amount of data per case differs from the
530      amount that the header claims.  SPSS version 13 gets this
531      wrong when very long strings are involved, so don't warn in
532      that case. */
533   if (header.nominal_case_size != -1 && header.nominal_case_size != n_vars
534       && info.version_major != 13)
535     sys_warn (r, -1, _("File header claims %d variable positions but "
536                        "%zu were read from file."),
537               header.nominal_case_size, n_vars);
538
539   /* Create an index of dictionary variable widths for
540      sfm_read_case to use.  We cannot use the `struct variable's
541      from the dictionary we created, because the caller owns the
542      dictionary and may destroy or modify its variables. */
543   sfm_dictionary_to_sfm_vars (dict, &r->sfm_vars, &r->sfm_var_cnt);
544   pool_register (r->pool, free, r->sfm_vars);
545   r->proto = caseproto_ref_pool (dict_get_proto (dict), r->pool);
546
547   *dictp = dict;
548   if (infop)
549     *infop = info;
550   else
551     sfm_read_info_destroy (&info);
552
553   return casereader_create_sequential
554     (NULL, r->proto,
555      r->case_cnt == -1 ? CASENUMBER_MAX: r->case_cnt,
556                                        &sys_file_casereader_class, r);
557
558 error:
559   sfm_read_info_destroy (&info);
560   close_reader (r);
561   dict_destroy (dict);
562   *dictp = NULL;
563   return NULL;
564 }
565
566 /* Closes a system file after we're done with it.
567    Returns true if an I/O error has occurred on READER, false
568    otherwise. */
569 static bool
570 close_reader (struct sfm_reader *r)
571 {
572   bool error;
573
574   if (r == NULL)
575     return true;
576
577   if (r->file)
578     {
579       if (fn_close (fh_get_file_name (r->fh), r->file) == EOF)
580         {
581           msg (ME, _("Error closing system file `%s': %s."),
582                fh_get_file_name (r->fh), strerror (errno));
583           r->error = true;
584         }
585       r->file = NULL;
586     }
587
588   fh_unlock (r->lock);
589   fh_unref (r->fh);
590
591   error = r->error;
592   pool_destroy (r->pool);
593
594   return !error;
595 }
596
597 /* Destroys READER. */
598 static void
599 sys_file_casereader_destroy (struct casereader *reader UNUSED, void *r_)
600 {
601   struct sfm_reader *r = r_;
602   close_reader (r);
603 }
604
605 /* Returns true if FILE is an SPSS system file,
606    false otherwise. */
607 bool
608 sfm_detect (FILE *file)
609 {
610   char magic[5];
611
612   if (fread (magic, 4, 1, file) != 1)
613     return false;
614   magic[4] = '\0';
615
616   return !strcmp (ASCII_MAGIC, magic) || !strcmp (EBCDIC_MAGIC, magic);
617 }
618 \f
619 /* Reads the global header of the system file.  Initializes *HEADER and *INFO,
620    except for the string fields in *INFO, which parse_header() will initialize
621    later once the file's encoding is known. */
622 static void
623 read_header (struct sfm_reader *r, struct sfm_read_info *info,
624              struct sfm_header_record *header)
625 {
626   uint8_t raw_layout_code[4];
627   uint8_t raw_bias[8];
628
629   read_string (r, header->magic, sizeof header->magic);
630   read_string (r, header->eye_catcher, sizeof header->eye_catcher);
631
632   if (strcmp (ASCII_MAGIC, header->magic)
633       && strcmp (EBCDIC_MAGIC, header->magic))
634     sys_error (r, 0, _("This is not an SPSS system file."));
635
636   /* Identify integer format. */
637   read_bytes (r, raw_layout_code, sizeof raw_layout_code);
638   if ((!integer_identify (2, raw_layout_code, sizeof raw_layout_code,
639                           &r->integer_format)
640        && !integer_identify (3, raw_layout_code, sizeof raw_layout_code,
641                              &r->integer_format))
642       || (r->integer_format != INTEGER_MSB_FIRST
643           && r->integer_format != INTEGER_LSB_FIRST))
644     sys_error (r, 64, _("This is not an SPSS system file."));
645
646   header->nominal_case_size = read_int (r);
647   if (header->nominal_case_size < 0
648       || header->nominal_case_size > INT_MAX / 16)
649     header->nominal_case_size = -1;
650
651   r->compressed = read_int (r) != 0;
652
653   header->weight_idx = read_int (r);
654
655   r->case_cnt = read_int (r);
656   if ( r->case_cnt > INT_MAX / 2)
657     r->case_cnt = -1;
658
659   /* Identify floating-point format and obtain compression bias. */
660   read_bytes (r, raw_bias, sizeof raw_bias);
661   if (float_identify (100.0, raw_bias, sizeof raw_bias, &r->float_format) == 0)
662     {
663       uint8_t zero_bias[8] = { 0, 0, 0, 0, 0, 0, 0, 0 };
664
665       if (memcmp (raw_bias, zero_bias, 8))
666         sys_warn (r, r->pos - 8,
667                   _("Compression bias is not the usual "
668                     "value of 100, or system file uses unrecognized "
669                     "floating-point format."));
670       else
671         {
672           /* Some software is known to write all-zeros to this
673              field.  Such software also writes floating-point
674              numbers in the format that we expect by default
675              (it seems that all software most likely does, in
676              reality), so don't warn in this case. */
677         }
678
679       if (r->integer_format == INTEGER_MSB_FIRST)
680         r->float_format = FLOAT_IEEE_DOUBLE_BE;
681       else
682         r->float_format = FLOAT_IEEE_DOUBLE_LE;
683     }
684   float_convert (r->float_format, raw_bias, FLOAT_NATIVE_DOUBLE, &r->bias);
685
686   read_string (r, header->creation_date, sizeof header->creation_date);
687   read_string (r, header->creation_time, sizeof header->creation_time);
688   read_string (r, header->file_label, sizeof header->file_label);
689   skip_bytes (r, 3);
690
691   info->integer_format = r->integer_format;
692   info->float_format = r->float_format;
693   info->compressed = r->compressed;
694   info->case_cnt = r->case_cnt;
695 }
696
697 /* Reads a variable (type 2) record from R into RECORD. */
698 static void
699 read_variable_record (struct sfm_reader *r, struct sfm_var_record *record)
700 {
701   int has_variable_label;
702
703   memset (record, 0, sizeof *record);
704
705   record->pos = r->pos;
706   record->width = read_int (r);
707   has_variable_label = read_int (r);
708   record->missing_value_code = read_int (r);
709   record->print_format = read_int (r);
710   record->write_format = read_int (r);
711   read_bytes (r, record->name, sizeof record->name);
712
713   if (has_variable_label == 1)
714     {
715       enum { MAX_LABEL_LEN = 255 };
716       size_t len, read_len;
717
718       len = read_int (r);
719
720       /* Read up to MAX_LABEL_LEN bytes of label. */
721       read_len = MIN (MAX_LABEL_LEN, len);
722       record->label = pool_malloc (r->pool, read_len + 1);
723       read_string (r, record->label, read_len + 1);
724
725       /* Skip unread label bytes. */
726       skip_bytes (r, len - read_len);
727
728       /* Skip label padding up to multiple of 4 bytes. */
729       skip_bytes (r, ROUND_UP (len, 4) - len);
730     }
731   else if (has_variable_label != 0)
732     sys_error (r, record->pos,
733                _("Variable label indicator field is not 0 or 1."));
734
735   /* Set missing values. */
736   if (record->missing_value_code != 0)
737     {
738       int code = record->missing_value_code;
739       if (record->width == 0)
740         {
741           if (code < -3 || code > 3 || code == -1)
742             sys_error (r, record->pos,
743                        _("Numeric missing value indicator field is not "
744                          "-3, -2, 0, 1, 2, or 3."));
745         }
746       else
747         {
748           if (code < 1 || code > 3)
749             sys_error (r, record->pos,
750                        _("String missing value indicator field is not "
751                          "0, 1, 2, or 3."));
752         }
753
754       read_bytes (r, record->missing, 8 * abs (code));
755     }
756 }
757
758 /* Reads value labels from R into RECORD. */
759 static void
760 read_value_label_record (struct sfm_reader *r,
761                          struct sfm_value_label_record *record,
762                          size_t n_vars)
763 {
764   size_t i;
765
766   /* Read type 3 record. */
767   record->pos = r->pos;
768   record->n_labels = read_int (r);
769   if (record->n_labels > SIZE_MAX / sizeof *record->labels)
770     sys_error (r, r->pos - 4, _("Invalid number of labels %zu."),
771                record->n_labels);
772   record->labels = pool_nmalloc (r->pool, record->n_labels,
773                                  sizeof *record->labels);
774   for (i = 0; i < record->n_labels; i++)
775     {
776       struct sfm_value_label *label = &record->labels[i];
777       unsigned char label_len;
778       size_t padded_len;
779
780       read_bytes (r, label->value, sizeof label->value);
781
782       /* Read label length. */
783       read_bytes (r, &label_len, sizeof label_len);
784       padded_len = ROUND_UP (label_len + 1, 8);
785
786       /* Read label, padding. */
787       label->label = pool_malloc (r->pool, padded_len + 1);
788       read_bytes (r, label->label, padded_len - 1);
789       label->label[label_len] = '\0';
790     }
791
792   /* Read record type of type 4 record. */
793   if (read_int (r) != 4)
794     sys_error (r, r->pos - 4,
795                _("Variable index record (type 4) does not immediately "
796                  "follow value label record (type 3) as it should."));
797
798   /* Read number of variables associated with value label from type 4
799      record. */
800   record->n_vars = read_int (r);
801   if (record->n_vars < 1 || record->n_vars > n_vars)
802     sys_error (r, r->pos - 4,
803                _("Number of variables associated with a value label (%zu) "
804                  "is not between 1 and the number of variables (%zu)."),
805                record->n_vars, n_vars);
806   record->vars = pool_nmalloc (r->pool, record->n_vars, sizeof *record->vars);
807   for (i = 0; i < record->n_vars; i++)
808     record->vars[i] = read_int (r);
809 }
810
811 /* Reads a document record from R and returns it. */
812 static struct sfm_document_record *
813 read_document_record (struct sfm_reader *r)
814 {
815   struct sfm_document_record *record;
816   int n_lines;
817
818   record = pool_malloc (r->pool, sizeof *record);
819   record->pos = r->pos;
820
821   n_lines = read_int (r);
822   if (n_lines <= 0 || n_lines >= INT_MAX / DOC_LINE_LENGTH)
823     sys_error (r, record->pos,
824                _("Number of document lines (%d) "
825                  "must be greater than 0 and less than %d."),
826                n_lines, INT_MAX / DOC_LINE_LENGTH);
827
828   record->n_lines = n_lines;
829   record->documents = pool_malloc (r->pool, DOC_LINE_LENGTH * n_lines);
830   read_bytes (r, record->documents, DOC_LINE_LENGTH * n_lines);
831
832   return record;
833 }
834
835 static void
836 read_extension_record_header (struct sfm_reader *r, int subtype,
837                               struct sfm_extension_record *record)
838 {
839   record->pos = r->pos;
840   record->size = read_int (r);
841   record->count = read_int (r);
842
843   /* Check that SIZE * COUNT + 1 doesn't overflow.  Adding 1
844      allows an extra byte for a null terminator, used by some
845      extension processing routines. */
846   if (record->size != 0
847       && size_overflow_p (xsum (1, xtimes (record->count, record->size))))
848     sys_error (r, record->pos, "Record type 7 subtype %d too large.", subtype);
849 }
850
851 /* Reads an extension record from R into RECORD. */
852 static struct sfm_extension_record *
853 read_extension_record (struct sfm_reader *r, int subtype)
854 {
855   struct extension_record_type
856     {
857       int subtype;
858       int size;
859       int count;
860     };
861
862   static const struct extension_record_type types[] =
863     {
864       /* Implemented record types. */
865       { EXT_INTEGER,      4, 8 },
866       { EXT_FLOAT,        8, 3 },
867       { EXT_MRSETS,       1, 0 },
868       { EXT_DISPLAY,      4, 0 },
869       { EXT_LONG_NAMES,   1, 0 },
870       { EXT_LONG_STRINGS, 1, 0 },
871       { EXT_NCASES,       8, 2 },
872       { EXT_FILE_ATTRS,   1, 0 },
873       { EXT_VAR_ATTRS,    1, 0 },
874       { EXT_MRSETS2,      1, 0 },
875       { EXT_ENCODING,     1, 0 },
876       { EXT_LONG_LABELS,  1, 0 },
877
878       /* Ignored record types. */
879       { EXT_VAR_SETS,     0, 0 },
880       { EXT_DATE,         0, 0 },
881       { EXT_DATA_ENTRY,   0, 0 },
882     };
883
884   const struct extension_record_type *type;
885   struct sfm_extension_record *record;
886   size_t n_bytes;
887
888   record = pool_malloc (r->pool, sizeof *record);
889   read_extension_record_header (r, subtype, record);
890   n_bytes = record->count * record->size;
891
892   for (type = types; type < &types[sizeof types / sizeof *types]; type++)
893     if (subtype == type->subtype)
894       {
895         if (type->size > 0 && record->size != type->size)
896           sys_warn (r, record->pos,
897                     _("Record type 7, subtype %d has bad size %zu "
898                       "(expected %d)."), subtype, record->size, type->size);
899         else if (type->count > 0 && record->count != type->count)
900           sys_warn (r, record->pos,
901                     _("Record type 7, subtype %d has bad count %zu "
902                       "(expected %d)."), subtype, record->count, type->count);
903         else if (type->count == 0 && type->size == 0)
904           {
905             /* Ignore this record. */
906           }
907         else
908           {
909             char *data = pool_malloc (r->pool, n_bytes + 1);
910             data[n_bytes] = '\0';
911
912             record->data = data;
913             read_bytes (r, record->data, n_bytes);
914             return record;
915           }
916
917         goto skip;
918       }
919
920   sys_warn (r, record->pos,
921             _("Unrecognized record type 7, subtype %d.  Please send a "
922               "copy of this file, and the syntax which created it to %s."),
923             subtype, PACKAGE_BUGREPORT);
924
925 skip:
926   skip_bytes (r, n_bytes);
927   return NULL;
928 }
929
930 static void
931 skip_extension_record (struct sfm_reader *r, int subtype)
932 {
933   struct sfm_extension_record record;
934
935   read_extension_record_header (r, subtype, &record);
936   skip_bytes (r, record.count * record.size);
937 }
938
939 static void
940 parse_header (struct sfm_reader *r, const struct sfm_header_record *header,
941               struct sfm_read_info *info, struct dictionary *dict)
942 {
943   const char *dict_encoding = dict_get_encoding (dict);
944   struct substring product;
945   struct substring label;
946
947   /* Convert file label to UTF-8 and put it into DICT. */
948   label = recode_substring_pool ("UTF-8", dict_encoding,
949                                  ss_cstr (header->file_label), r->pool);
950   ss_trim (&label, ss_cstr (" "));
951   label.string[label.length] = '\0';
952   dict_set_label (dict, label.string);
953
954   /* Put creation date and time in UTF-8 into INFO. */
955   info->creation_date = recode_string ("UTF-8", dict_encoding,
956                                        header->creation_date, -1);
957   info->creation_time = recode_string ("UTF-8", dict_encoding,
958                                        header->creation_time, -1);
959
960   /* Put product name into INFO, dropping eye-catcher string if present. */
961   product = recode_substring_pool ("UTF-8", dict_encoding,
962                                    ss_cstr (header->eye_catcher), r->pool);
963   ss_match_string (&product, ss_cstr ("@(#) SPSS DATA FILE"));
964   ss_trim (&product, ss_cstr (" "));
965   info->product = ss_xstrdup (product);
966 }
967
968 /* Reads a variable (type 2) record from R and adds the
969    corresponding variable to DICT.
970    Also skips past additional variable records for long string
971    variables. */
972 static void
973 parse_variable_records (struct sfm_reader *r, struct dictionary *dict,
974                         struct sfm_var_record *var_recs, size_t n_var_recs)
975 {
976   const char *dict_encoding = dict_get_encoding (dict);
977   struct sfm_var_record *rec;
978   int n_warnings = 0;
979
980   for (rec = var_recs; rec < &var_recs[n_var_recs]; )
981     {
982       struct variable *var;
983       size_t n_values;
984       char *name;
985       size_t i;
986
987       name = recode_string_pool ("UTF-8", dict_encoding,
988                                  rec->name, 8, r->pool);
989       name[strcspn (name, " ")] = '\0';
990
991       if (!dict_id_is_valid (dict, name, false)
992           || name[0] == '$' || name[0] == '#')
993         sys_error (r, rec->pos, _("Invalid variable name `%s'."), name);
994
995       if (rec->width < 0 || rec->width > 255)
996         sys_error (r, rec->pos,
997                    _("Bad width %d for variable %s."), rec->width, name);
998
999       var = rec->var = dict_create_var (dict, name, rec->width);
1000       if (var == NULL)
1001         sys_error (r, rec->pos, _("Duplicate variable name `%s'."), name);
1002
1003       /* Set the short name the same as the long name. */
1004       var_set_short_name (var, 0, name);
1005
1006       /* Get variable label, if any. */
1007       if (rec->label)
1008         {
1009           char *utf8_label;
1010
1011           utf8_label = recode_string_pool ("UTF-8", dict_encoding,
1012                                            rec->label, -1, r->pool);
1013           var_set_label (var, utf8_label, false);
1014         }
1015
1016       /* Set missing values. */
1017       if (rec->missing_value_code != 0)
1018         {
1019           int width = var_get_width (var);
1020           struct missing_values mv;
1021
1022           mv_init_pool (r->pool, &mv, width);
1023           if (var_is_numeric (var))
1024             {
1025               bool has_range = rec->missing_value_code < 0;
1026               int n_discrete = (has_range
1027                                 ? rec->missing_value_code == -3
1028                                 : rec->missing_value_code);
1029               int ofs = 0;
1030
1031               if (has_range)
1032                 {
1033                   double low = parse_float (r, rec->missing, 0);
1034                   double high = parse_float (r, rec->missing, 8);
1035                   mv_add_range (&mv, low, high);
1036                   ofs += 16;
1037                 }
1038
1039               for (i = 0; i < n_discrete; i++)
1040                 {
1041                   mv_add_num (&mv, parse_float (r, rec->missing, ofs));
1042                   ofs += 8;
1043                 }
1044             }
1045           else
1046             {
1047               union value value;
1048
1049               value_init_pool (r->pool, &value, width);
1050               value_set_missing (&value, width);
1051               for (i = 0; i < rec->missing_value_code; i++)
1052                 {
1053                   uint8_t *s = value_str_rw (&value, width);
1054                   memcpy (s, rec->missing + 8 * i, MIN (width, 8));
1055                   mv_add_str (&mv, s);
1056                 }
1057             }
1058           var_set_missing_values (var, &mv);
1059         }
1060
1061       /* Set formats. */
1062       parse_format_spec (r, rec->pos + 12, rec->print_format,
1063                          PRINT_FORMAT, var, &n_warnings);
1064       parse_format_spec (r, rec->pos + 16, rec->write_format,
1065                          WRITE_FORMAT, var, &n_warnings);
1066
1067       /* Account for values.
1068          Skip long string continuation records, if any. */
1069       n_values = rec->width == 0 ? 1 : DIV_RND_UP (rec->width, 8);
1070       for (i = 1; i < n_values; i++)
1071         if (i + (rec - var_recs) >= n_var_recs || rec[i].width != -1)
1072           sys_error (r, rec->pos, _("Missing string continuation record."));
1073       rec += n_values;
1074     }
1075 }
1076
1077 /* Translates the format spec from sysfile format to internal
1078    format. */
1079 static void
1080 parse_format_spec (struct sfm_reader *r, off_t pos, unsigned int format,
1081                    enum which_format which, struct variable *v,
1082                    int *n_warnings)
1083 {
1084   const int max_warnings = 8;
1085   uint8_t raw_type = format >> 16;
1086   uint8_t w = format >> 8;
1087   uint8_t d = format;
1088   struct fmt_spec f;
1089   bool ok;
1090
1091   f.w = w;
1092   f.d = d;
1093
1094   msg_disable ();
1095   ok = (fmt_from_io (raw_type, &f.type)
1096         && fmt_check_output (&f)
1097         && fmt_check_width_compat (&f, var_get_width (v)));
1098   msg_enable ();
1099
1100   if (ok)
1101     {
1102       if (which == PRINT_FORMAT)
1103         var_set_print_format (v, &f);
1104       else
1105         var_set_write_format (v, &f);
1106     }
1107   else if (format == 0)
1108     {
1109       /* Actually observed in the wild.  No point in warning about it. */
1110     }
1111   else if (++*n_warnings <= max_warnings)
1112     {
1113       if (which == PRINT_FORMAT)
1114         sys_warn (r, pos, _("Variable %s with width %d has invalid print "
1115                             "format 0x%x."),
1116                   var_get_name (v), var_get_width (v), format);
1117       else
1118         sys_warn (r, pos, _("Variable %s with width %d has invalid write "
1119                             "format 0x%x."),
1120                   var_get_name (v), var_get_width (v), format);
1121
1122       if (*n_warnings == max_warnings)
1123         sys_warn (r, -1, _("Suppressing further invalid format warnings."));
1124     }
1125 }
1126
1127 static void
1128 parse_document (struct dictionary *dict, struct sfm_document_record *record)
1129 {
1130   const char *p;
1131
1132   for (p = record->documents;
1133        p < record->documents + DOC_LINE_LENGTH * record->n_lines;
1134        p += DOC_LINE_LENGTH)
1135     {
1136       struct substring line;
1137
1138       line = recode_substring_pool ("UTF-8", dict_get_encoding (dict),
1139                                     ss_buffer (p, DOC_LINE_LENGTH), NULL);
1140       ss_rtrim (&line, ss_cstr (" "));
1141       line.string[line.length] = '\0';
1142
1143       dict_add_document_line (dict, line.string, false);
1144
1145       ss_dealloc (&line);
1146     }
1147 }
1148
1149 /* Parses record type 7, subtype 3. */
1150 static void
1151 parse_machine_integer_info (struct sfm_reader *r,
1152                             const struct sfm_extension_record *record,
1153                             struct sfm_read_info *info)
1154 {
1155   int float_representation, expected_float_format;
1156   int integer_representation, expected_integer_format;
1157
1158   /* Save version info. */
1159   info->version_major = parse_int (r, record->data, 0);
1160   info->version_minor = parse_int (r, record->data, 4);
1161   info->version_revision = parse_int (r, record->data, 8);
1162
1163   /* Check floating point format. */
1164   float_representation = parse_int (r, record->data, 16);
1165   if (r->float_format == FLOAT_IEEE_DOUBLE_BE
1166       || r->float_format == FLOAT_IEEE_DOUBLE_LE)
1167     expected_float_format = 1;
1168   else if (r->float_format == FLOAT_Z_LONG)
1169     expected_float_format = 2;
1170   else if (r->float_format == FLOAT_VAX_G || r->float_format == FLOAT_VAX_D)
1171     expected_float_format = 3;
1172   else
1173     NOT_REACHED ();
1174   if (float_representation != expected_float_format)
1175     sys_error (r, record->pos, _("Floating-point representation indicated by "
1176                  "system file (%d) differs from expected (%d)."),
1177                float_representation, expected_float_format);
1178
1179   /* Check integer format. */
1180   integer_representation = parse_int (r, record->data, 24);
1181   if (r->integer_format == INTEGER_MSB_FIRST)
1182     expected_integer_format = 1;
1183   else if (r->integer_format == INTEGER_LSB_FIRST)
1184     expected_integer_format = 2;
1185   else
1186     NOT_REACHED ();
1187   if (integer_representation != expected_integer_format)
1188     sys_warn (r, record->pos,
1189               _("Integer format indicated by system file (%d) "
1190                 "differs from expected (%d)."),
1191               integer_representation, expected_integer_format);
1192
1193 }
1194
1195 static const char *
1196 choose_encoding (struct sfm_reader *r,
1197                  const struct sfm_header_record *header,
1198                  const struct sfm_extension_record *ext_integer,
1199                  const struct sfm_extension_record *ext_encoding)
1200 {
1201   /* The EXT_ENCODING record is a more reliable way to determine dictionary
1202      encoding. */
1203   if (ext_encoding)
1204     return ext_encoding->data;
1205
1206   /* But EXT_INTEGER is better than nothing as a fallback. */
1207   if (ext_integer)
1208     {
1209       int codepage = parse_int (r, ext_integer->data, 7 * 4);
1210       const char *encoding;
1211
1212       switch (codepage)
1213         {
1214         case 1:
1215           return "EBCDIC-US";
1216
1217         case 2:
1218         case 3:
1219           /* These ostensibly mean "7-bit ASCII" and "8-bit ASCII"[sic]
1220              respectively.  However, there are known to be many files in the wild
1221              with character code 2, yet have data which are clearly not ASCII.
1222              Therefore we ignore these values. */
1223           break;
1224
1225         case 4:
1226           return "MS_KANJI";
1227
1228         default:
1229           encoding = sys_get_encoding_from_codepage (codepage);
1230           if (encoding != NULL)
1231             return encoding;
1232           break;
1233         }
1234     }
1235
1236   /* If the file magic number is EBCDIC then its character data is too. */
1237   if (!strcmp (header->magic, EBCDIC_MAGIC))
1238     return "EBCDIC-US";
1239
1240   return locale_charset ();
1241 }
1242
1243 /* Parses record type 7, subtype 4. */
1244 static void
1245 parse_machine_float_info (struct sfm_reader *r,
1246                           const struct sfm_extension_record *record)
1247 {
1248   double sysmis = parse_float (r, record->data, 0);
1249   double highest = parse_float (r, record->data, 8);
1250   double lowest = parse_float (r, record->data, 16);
1251
1252   if (sysmis != SYSMIS)
1253     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1254               sysmis, "SYSMIS");
1255
1256   if (highest != HIGHEST)
1257     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1258               highest, "HIGHEST");
1259
1260   if (lowest != LOWEST)
1261     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1262               lowest, "LOWEST");
1263 }
1264
1265 /* Parses record type 7, subtype 7 or 19. */
1266 static void
1267 parse_mrsets (struct sfm_reader *r, const struct sfm_extension_record *record,
1268               struct dictionary *dict)
1269 {
1270   struct text_record *text;
1271   struct mrset *mrset;
1272
1273   text = open_text_record (r, record, false);
1274   for (;;)
1275     {
1276       const char *counted = NULL;
1277       const char *name;
1278       const char *label;
1279       struct stringi_set var_names;
1280       size_t allocated_vars;
1281       char delimiter;
1282       int width;
1283
1284       mrset = xzalloc (sizeof *mrset);
1285
1286       name = text_get_token (text, ss_cstr ("="), NULL);
1287       if (name == NULL)
1288         break;
1289       mrset->name = recode_string ("UTF-8", r->encoding, name, -1);
1290
1291       if (mrset->name[0] != '$')
1292         {
1293           sys_warn (r, record->pos,
1294                     _("`%s' does not begin with `$' at offset %zu "
1295                       "in MRSETS record."), mrset->name, text_pos (text));
1296           break;
1297         }
1298
1299       if (text_match (text, 'C'))
1300         {
1301           mrset->type = MRSET_MC;
1302           if (!text_match (text, ' '))
1303             {
1304               sys_warn (r, record->pos,
1305                         _("Missing space following `%c' at offset %zu "
1306                           "in MRSETS record."), 'C', text_pos (text));
1307               break;
1308             }
1309         }
1310       else if (text_match (text, 'D'))
1311         {
1312           mrset->type = MRSET_MD;
1313           mrset->cat_source = MRSET_VARLABELS;
1314         }
1315       else if (text_match (text, 'E'))
1316         {
1317           char *number;
1318
1319           mrset->type = MRSET_MD;
1320           mrset->cat_source = MRSET_COUNTEDVALUES;
1321           if (!text_match (text, ' '))
1322             {
1323               sys_warn (r, record->pos,
1324                         _("Missing space following `%c' at offset %zu "
1325                           "in MRSETS record."), 'E',  text_pos (text));
1326               break;
1327             }
1328
1329           number = text_get_token (text, ss_cstr (" "), NULL);
1330           if (!strcmp (number, "11"))
1331             mrset->label_from_var_label = true;
1332           else if (strcmp (number, "1"))
1333             sys_warn (r, record->pos,
1334                       _("Unexpected label source value `%s' following `E' "
1335                         "at offset %zu in MRSETS record."),
1336                       number, text_pos (text));
1337         }
1338       else
1339         {
1340           sys_warn (r, record->pos,
1341                     _("Missing `C', `D', or `E' at offset %zu "
1342                       "in MRSETS record."),
1343                     text_pos (text));
1344           break;
1345         }
1346
1347       if (mrset->type == MRSET_MD)
1348         {
1349           counted = text_parse_counted_string (r, text);
1350           if (counted == NULL)
1351             break;
1352         }
1353
1354       label = text_parse_counted_string (r, text);
1355       if (label == NULL)
1356         break;
1357       if (label[0] != '\0')
1358         mrset->label = recode_string ("UTF-8", r->encoding, label, -1);
1359
1360       stringi_set_init (&var_names);
1361       allocated_vars = 0;
1362       width = INT_MAX;
1363       do
1364         {
1365           const char *raw_var_name;
1366           struct variable *var;
1367           char *var_name;
1368
1369           raw_var_name = text_get_token (text, ss_cstr (" \n"), &delimiter);
1370           if (raw_var_name == NULL)
1371             {
1372               sys_warn (r, record->pos,
1373                         _("Missing new-line parsing variable names "
1374                           "at offset %zu in MRSETS record."),
1375                         text_pos (text));
1376               break;
1377             }
1378           var_name = recode_string ("UTF-8", r->encoding, raw_var_name, -1);
1379
1380           var = dict_lookup_var (dict, var_name);
1381           if (var == NULL)
1382             {
1383               free (var_name);
1384               continue;
1385             }
1386           if (!stringi_set_insert (&var_names, var_name))
1387             {
1388               sys_warn (r, record->pos,
1389                         _("Duplicate variable name %s "
1390                           "at offset %zu in MRSETS record."),
1391                         var_name, text_pos (text));
1392               free (var_name);
1393               continue;
1394             }
1395           free (var_name);
1396
1397           if (mrset->label == NULL && mrset->label_from_var_label
1398               && var_has_label (var))
1399             mrset->label = xstrdup (var_get_label (var));
1400
1401           if (mrset->n_vars
1402               && var_get_type (var) != var_get_type (mrset->vars[0]))
1403             {
1404               sys_warn (r, record->pos,
1405                         _("MRSET %s contains both string and "
1406                           "numeric variables."), name);
1407               continue;
1408             }
1409           width = MIN (width, var_get_width (var));
1410
1411           if (mrset->n_vars >= allocated_vars)
1412             mrset->vars = x2nrealloc (mrset->vars, &allocated_vars,
1413                                       sizeof *mrset->vars);
1414           mrset->vars[mrset->n_vars++] = var;
1415         }
1416       while (delimiter != '\n');
1417
1418       if (mrset->n_vars < 2)
1419         {
1420           sys_warn (r, record->pos,
1421                     _("MRSET %s has only %zu variables."), mrset->name,
1422                     mrset->n_vars);
1423           mrset_destroy (mrset);
1424           continue;
1425         }
1426
1427       if (mrset->type == MRSET_MD)
1428         {
1429           mrset->width = width;
1430           value_init (&mrset->counted, width);
1431           if (width == 0)
1432             mrset->counted.f = strtod (counted, NULL);
1433           else
1434             value_copy_str_rpad (&mrset->counted, width,
1435                                  (const uint8_t *) counted, ' ');
1436         }
1437
1438       dict_add_mrset (dict, mrset);
1439       mrset = NULL;
1440       stringi_set_destroy (&var_names);
1441     }
1442   mrset_destroy (mrset);
1443   close_text_record (r, text);
1444 }
1445
1446 /* Read record type 7, subtype 11, which specifies how variables
1447    should be displayed in GUI environments. */
1448 static void
1449 parse_display_parameters (struct sfm_reader *r,
1450                          const struct sfm_extension_record *record,
1451                          struct dictionary *dict)
1452 {
1453   bool includes_width;
1454   bool warned = false;
1455   size_t n_vars;
1456   size_t ofs;
1457   size_t i;
1458
1459   n_vars = dict_get_var_cnt (dict);
1460   if (record->count == 3 * n_vars)
1461     includes_width = true;
1462   else if (record->count == 2 * n_vars)
1463     includes_width = false;
1464   else
1465     {
1466       sys_warn (r, record->pos,
1467                 _("Extension 11 has bad count %zu (for %zu variables)."),
1468                 record->count, n_vars);
1469       return;
1470     }
1471
1472   ofs = 0;
1473   for (i = 0; i < n_vars; ++i)
1474     {
1475       struct variable *v = dict_get_var (dict, i);
1476       int measure, width, align;
1477
1478       measure = parse_int (r, record->data, ofs);
1479       ofs += 4;
1480
1481       if (includes_width)
1482         {
1483           width = parse_int (r, record->data, ofs);
1484           ofs += 4;
1485         }
1486       else
1487         width = 0;
1488
1489       align = parse_int (r, record->data, ofs);
1490       ofs += 4;
1491
1492       /* SPSS 14 sometimes seems to set string variables' measure
1493          to zero. */
1494       if (0 == measure && var_is_alpha (v))
1495         measure = 1;
1496
1497       if (measure < 1 || measure > 3 || align < 0 || align > 2)
1498         {
1499           if (!warned)
1500             sys_warn (r, record->pos,
1501                       _("Invalid variable display parameters for variable "
1502                         "%zu (%s).  Default parameters substituted."),
1503                       i, var_get_name (v));
1504           warned = true;
1505           continue;
1506         }
1507
1508       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
1509                            : measure == 2 ? MEASURE_ORDINAL
1510                            : MEASURE_SCALE));
1511       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
1512                              : align == 1 ? ALIGN_RIGHT
1513                              : ALIGN_CENTRE));
1514
1515       /* Older versions (SPSS 9.0) sometimes set the display
1516          width to zero.  This causes confusion in the GUI, so
1517          only set the width if it is nonzero. */
1518       if (width > 0)
1519         var_set_display_width (v, width);
1520     }
1521 }
1522
1523 static void
1524 rename_var_and_save_short_names (struct dictionary *dict, struct variable *var,
1525                                  const char *new_name)
1526 {
1527   size_t n_short_names;
1528   char **short_names;
1529   size_t i;
1530
1531   /* Renaming a variable may clear its short names, but we
1532      want to retain them, so we save them and re-set them
1533      afterward. */
1534   n_short_names = var_get_short_name_cnt (var);
1535   short_names = xnmalloc (n_short_names, sizeof *short_names);
1536   for (i = 0; i < n_short_names; i++)
1537     {
1538       const char *s = var_get_short_name (var, i);
1539       short_names[i] = s != NULL ? xstrdup (s) : NULL;
1540     }
1541
1542   /* Set long name. */
1543   dict_rename_var (dict, var, new_name);
1544
1545   /* Restore short names. */
1546   for (i = 0; i < n_short_names; i++)
1547     {
1548       var_set_short_name (var, i, short_names[i]);
1549       free (short_names[i]);
1550     }
1551   free (short_names);
1552 }
1553
1554 /* Parses record type 7, subtype 13, which gives the long name that corresponds
1555    to each short name.  Modifies variable names in DICT accordingly.  */
1556 static void
1557 parse_long_var_name_map (struct sfm_reader *r,
1558                          const struct sfm_extension_record *record,
1559                          struct dictionary *dict)
1560 {
1561   struct text_record *text;
1562   struct variable *var;
1563   char *long_name;
1564
1565   if (record == NULL)
1566     {
1567       /* Convert variable names to lowercase. */
1568       size_t i;
1569
1570       for (i = 0; i < dict_get_var_cnt (dict); i++)
1571         {
1572           struct variable *var = dict_get_var (dict, i);
1573           char *new_name;
1574
1575           new_name = xstrdup (var_get_name (var));
1576           str_lowercase (new_name);
1577
1578           rename_var_and_save_short_names (dict, var, new_name);
1579
1580           free (new_name);
1581         }
1582
1583       return;
1584     }
1585
1586   /* Rename each of the variables, one by one.  (In a correctly constructed
1587      system file, this cannot create any intermediate duplicate variable names,
1588      because all of the new variable names are longer than any of the old
1589      variable names and thus there cannot be any overlaps.) */
1590   text = open_text_record (r, record, true);
1591   while (read_variable_to_value_pair (r, dict, text, &var, &long_name))
1592     {
1593       /* Validate long name. */
1594       if (!dict_id_is_valid (dict, long_name, false))
1595         {
1596           sys_warn (r, record->pos,
1597                     _("Long variable mapping from %s to invalid "
1598                       "variable name `%s'."),
1599                     var_get_name (var), long_name);
1600           continue;
1601         }
1602
1603       /* Identify any duplicates. */
1604       if (strcasecmp (var_get_short_name (var, 0), long_name)
1605           && dict_lookup_var (dict, long_name) != NULL)
1606         {
1607           sys_warn (r, record->pos,
1608                     _("Duplicate long variable name `%s'."), long_name);
1609           continue;
1610         }
1611
1612       rename_var_and_save_short_names (dict, var, long_name);
1613     }
1614   close_text_record (r, text);
1615 }
1616
1617 /* Reads record type 7, subtype 14, which gives the real length
1618    of each very long string.  Rearranges DICT accordingly. */
1619 static void
1620 parse_long_string_map (struct sfm_reader *r,
1621                        const struct sfm_extension_record *record,
1622                        struct dictionary *dict)
1623 {
1624   struct text_record *text;
1625   struct variable *var;
1626   char *length_s;
1627
1628   text = open_text_record (r, record, true);
1629   while (read_variable_to_value_pair (r, dict, text, &var, &length_s))
1630     {
1631       size_t idx = var_get_dict_index (var);
1632       long int length;
1633       int segment_cnt;
1634       int i;
1635
1636       /* Get length. */
1637       length = strtol (length_s, NULL, 10);
1638       if (length < 1 || length > MAX_STRING)
1639         {
1640           sys_warn (r, record->pos,
1641                     _("%s listed as string of invalid length %s "
1642                       "in very long string record."),
1643                     var_get_name (var), length_s);
1644           continue;
1645         }
1646
1647       /* Check segments. */
1648       segment_cnt = sfm_width_to_segments (length);
1649       if (segment_cnt == 1)
1650         {
1651           sys_warn (r, record->pos,
1652                     _("%s listed in very long string record with width %s, "
1653                       "which requires only one segment."),
1654                     var_get_name (var), length_s);
1655           continue;
1656         }
1657       if (idx + segment_cnt > dict_get_var_cnt (dict))
1658         sys_error (r, record->pos,
1659                    _("Very long string %s overflows dictionary."),
1660                    var_get_name (var));
1661
1662       /* Get the short names from the segments and check their
1663          lengths. */
1664       for (i = 0; i < segment_cnt; i++)
1665         {
1666           struct variable *seg = dict_get_var (dict, idx + i);
1667           int alloc_width = sfm_segment_alloc_width (length, i);
1668           int width = var_get_width (seg);
1669
1670           if (i > 0)
1671             var_set_short_name (var, i, var_get_short_name (seg, 0));
1672           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
1673             sys_error (r, record->pos,
1674                        _("Very long string with width %ld has segment %d "
1675                          "of width %d (expected %d)."),
1676                        length, i, width, alloc_width);
1677         }
1678       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1679       var_set_width (var, length);
1680     }
1681   close_text_record (r, text);
1682   dict_compact_values (dict);
1683 }
1684
1685 static void
1686 parse_value_labels (struct sfm_reader *r, struct dictionary *dict,
1687                     const struct sfm_var_record *var_recs, size_t n_var_recs,
1688                     const struct sfm_value_label_record *record)
1689 {
1690   struct variable **vars;
1691   char **utf8_labels;
1692   size_t i;
1693
1694   utf8_labels = pool_nmalloc (r->pool, sizeof *utf8_labels, record->n_labels);
1695   for (i = 0; i < record->n_labels; i++)
1696     utf8_labels[i] = recode_string_pool ("UTF-8", dict_get_encoding (dict),
1697                                          record->labels[i].label, -1,
1698                                          r->pool);
1699
1700   vars = pool_nmalloc (r->pool, record->n_vars, sizeof *vars);
1701   for (i = 0; i < record->n_vars; i++)
1702     vars[i] = lookup_var_by_index (r, record->pos,
1703                                    var_recs, n_var_recs, record->vars[i]);
1704
1705   for (i = 1; i < record->n_vars; i++)
1706     if (var_get_type (vars[i]) != var_get_type (vars[0]))
1707       sys_error (r, record->pos,
1708                  _("Variables associated with value label are not all of "
1709                    "identical type.  Variable %s is %s, but variable "
1710                    "%s is %s."),
1711                  var_get_name (vars[0]),
1712                  var_is_numeric (vars[0]) ? _("numeric") : _("string"),
1713                  var_get_name (vars[i]),
1714                  var_is_numeric (vars[i]) ? _("numeric") : _("string"));
1715
1716   for (i = 0; i < record->n_vars; i++)
1717     {
1718       struct variable *var = vars[i];
1719       int width;
1720       size_t j;
1721
1722       width = var_get_width (var);
1723       if (width > 8)
1724         sys_error (r, record->pos,
1725                    _("Value labels may not be added to long string "
1726                      "variables (e.g. %s) using records types 3 and 4."),
1727                    var_get_name (var));
1728
1729       for (j = 0; j < record->n_labels; j++)
1730         {
1731           struct sfm_value_label *label = &record->labels[j];
1732           union value value;
1733
1734           value_init (&value, width);
1735           if (width == 0)
1736             value.f = parse_float (r, label->value, 0);
1737           else
1738             memcpy (value_str_rw (&value, width), label->value, width);
1739
1740           if (!var_add_value_label (var, &value, utf8_labels[j]))
1741             {
1742               if (var_is_numeric (var))
1743                 sys_warn (r, record->pos,
1744                           _("Duplicate value label for %g on %s."),
1745                           value.f, var_get_name (var));
1746               else
1747                 sys_warn (r, record->pos,
1748                           _("Duplicate value label for `%.*s' on %s."),
1749                           width, value_str (&value, width),
1750                           var_get_name (var));
1751             }
1752
1753           value_destroy (&value, width);
1754         }
1755     }
1756
1757   pool_free (r->pool, vars);
1758   for (i = 0; i < record->n_labels; i++)
1759     pool_free (r->pool, utf8_labels[i]);
1760   pool_free (r->pool, utf8_labels);
1761 }
1762
1763 static struct variable *
1764 lookup_var_by_index (struct sfm_reader *r, off_t offset,
1765                      const struct sfm_var_record *var_recs, size_t n_var_recs,
1766                      int idx)
1767 {
1768   const struct sfm_var_record *rec;
1769
1770   if (idx < 1 || idx > n_var_recs)
1771     {
1772       sys_error (r, offset,
1773                  _("Variable index %d not in valid range 1...%zu."),
1774                  idx, n_var_recs);
1775       return NULL;
1776     }
1777
1778   rec = &var_recs[idx - 1];
1779   if (rec->var == NULL)
1780     {
1781       sys_error (r, offset,
1782                  _("Variable index %d refers to long string continuation."),
1783                  idx);
1784       return NULL;
1785     }
1786
1787   return rec->var;
1788 }
1789
1790 /* Parses a set of custom attributes from TEXT into ATTRS.
1791    ATTRS may be a null pointer, in which case the attributes are
1792    read but discarded. */
1793 static void
1794 parse_attributes (struct sfm_reader *r, struct text_record *text,
1795                   struct attrset *attrs)
1796 {
1797   do
1798     {
1799       struct attribute *attr;
1800       char *key;
1801       int index;
1802
1803       /* Parse the key. */
1804       key = text_get_token (text, ss_cstr ("("), NULL);
1805       if (key == NULL)
1806         return;
1807
1808       attr = attribute_create (key);
1809       for (index = 1; ; index++)
1810         {
1811           /* Parse the value. */
1812           char *value;
1813           size_t length;
1814
1815           value = text_get_token (text, ss_cstr ("\n"), NULL);
1816           if (value == NULL)
1817             {
1818               text_warn (r, text, _("Error parsing attribute value %s[%d]."),
1819                          key, index);
1820               break;
1821             }              
1822
1823           length = strlen (value);
1824           if (length >= 2 && value[0] == '\'' && value[length - 1] == '\'') 
1825             {
1826               value[length - 1] = '\0';
1827               attribute_add_value (attr, value + 1); 
1828             }
1829           else 
1830             {
1831               text_warn (r, text,
1832                          _("Attribute value %s[%d] is not quoted: %s."),
1833                          key, index, value);
1834               attribute_add_value (attr, value); 
1835             }
1836
1837           /* Was this the last value for this attribute? */
1838           if (text_match (text, ')'))
1839             break;
1840         }
1841       if (attrs != NULL)
1842         attrset_add (attrs, attr);
1843       else
1844         attribute_destroy (attr);
1845     }
1846   while (!text_match (text, '/'));
1847 }
1848
1849 /* Reads record type 7, subtype 17, which lists custom
1850    attributes on the data file.  */
1851 static void
1852 parse_data_file_attributes (struct sfm_reader *r,
1853                             const struct sfm_extension_record *record,
1854                             struct dictionary *dict)
1855 {
1856   struct text_record *text = open_text_record (r, record, true);
1857   parse_attributes (r, text, dict_get_attributes (dict));
1858   close_text_record (r, text);
1859 }
1860
1861 /* Parses record type 7, subtype 18, which lists custom
1862    attributes on individual variables.  */
1863 static void
1864 parse_variable_attributes (struct sfm_reader *r,
1865                            const struct sfm_extension_record *record,
1866                            struct dictionary *dict)
1867 {
1868   struct text_record *text;
1869   struct variable *var;
1870
1871   text = open_text_record (r, record, true);
1872   while (text_read_variable_name (r, dict, text, ss_cstr (":"), &var))
1873     parse_attributes (r, text, var != NULL ? var_get_attributes (var) : NULL);
1874   close_text_record (r, text);
1875 }
1876
1877 static void
1878 check_overflow (struct sfm_reader *r,
1879                 const struct sfm_extension_record *record,
1880                 size_t ofs, size_t length)
1881 {
1882   size_t end = record->size * record->count;
1883   if (length >= end || ofs + length > end)
1884     sys_error (r, record->pos + end,
1885                _("Long string value label record ends unexpectedly."));
1886 }
1887
1888 static void
1889 parse_long_string_value_labels (struct sfm_reader *r,
1890                                 const struct sfm_extension_record *record,
1891                                 struct dictionary *dict)
1892 {
1893   const char *dict_encoding = dict_get_encoding (dict);
1894   size_t end = record->size * record->count;
1895   size_t ofs = 0;
1896
1897   while (ofs < end)
1898     {
1899       char *var_name;
1900       size_t n_labels, i;
1901       struct variable *var;
1902       union value value;
1903       int var_name_len;
1904       int width;
1905
1906       /* Parse variable name length. */
1907       check_overflow (r, record, ofs, 4);
1908       var_name_len = parse_int (r, record->data, ofs);
1909       ofs += 4;
1910
1911       /* Parse variable name, width, and number of labels. */
1912       check_overflow (r, record, ofs, var_name_len + 8);
1913       var_name = recode_string_pool ("UTF-8", dict_encoding,
1914                                      (const char *) record->data + ofs,
1915                                      var_name_len, r->pool);
1916       width = parse_int (r, record->data, ofs + var_name_len);
1917       n_labels = parse_int (r, record->data, ofs + var_name_len + 4);
1918       ofs += var_name_len + 8;
1919
1920       /* Look up 'var' and validate. */
1921       var = dict_lookup_var (dict, var_name);
1922       if (var == NULL)
1923         sys_warn (r, record->pos + ofs,
1924                   _("Ignoring long string value record for "
1925                     "unknown variable %s."), var_name);
1926       else if (var_is_numeric (var))
1927         {
1928           sys_warn (r, record->pos + ofs,
1929                     _("Ignoring long string value record for "
1930                       "numeric variable %s."), var_name);
1931           var = NULL;
1932         }
1933       else if (width != var_get_width (var))
1934         {
1935           sys_warn (r, record->pos + ofs,
1936                     _("Ignoring long string value record for variable %s "
1937                       "because the record's width (%d) does not match the "
1938                       "variable's width (%d)."),
1939                     var_name, width, var_get_width (var));
1940           var = NULL;
1941         }
1942
1943       /* Parse values. */
1944       value_init_pool (r->pool, &value, width);
1945       for (i = 0; i < n_labels; i++)
1946         {
1947           size_t value_length, label_length;
1948           bool skip = var == NULL;
1949
1950           /* Parse value length. */
1951           check_overflow (r, record, ofs, 4);
1952           value_length = parse_int (r, record->data, ofs);
1953           ofs += 4;
1954
1955           /* Parse value. */
1956           check_overflow (r, record, ofs, value_length);
1957           if (!skip)
1958             {
1959               if (value_length == width)
1960                 memcpy (value_str_rw (&value, width),
1961                         (const uint8_t *) record->data + ofs, width);
1962               else
1963                 {
1964                   sys_warn (r, record->pos + ofs,
1965                             _("Ignoring long string value %zu for variable "
1966                               "%s, with width %d, that has bad value "
1967                               "width %zu."),
1968                             i, var_get_name (var), width, value_length);
1969                   skip = true;
1970                 }
1971             }
1972           ofs += value_length;
1973
1974           /* Parse label length. */
1975           check_overflow (r, record, ofs, 4);
1976           label_length = parse_int (r, record->data, ofs);
1977           ofs += 4;
1978
1979           /* Parse label. */
1980           check_overflow (r, record, ofs, label_length);
1981           if (!skip)
1982             {
1983               char *label;
1984
1985               label = recode_string_pool ("UTF-8", dict_encoding,
1986                                           (const char *) record->data + ofs,
1987                                           label_length, r->pool);
1988               if (!var_add_value_label (var, &value, label))
1989                 sys_warn (r, record->pos + ofs,
1990                           _("Duplicate value label for `%.*s' on %s."),
1991                           width, value_str (&value, width),
1992                           var_get_name (var));
1993               pool_free (r->pool, label);
1994             }
1995           ofs += label_length;
1996         }
1997     }
1998 }
1999 \f
2000 /* Case reader. */
2001
2002 static void partial_record (struct sfm_reader *r)
2003      NO_RETURN;
2004
2005 static void read_error (struct casereader *, const struct sfm_reader *);
2006
2007 static bool read_case_number (struct sfm_reader *, double *);
2008 static bool read_case_string (struct sfm_reader *, uint8_t *, size_t);
2009 static int read_opcode (struct sfm_reader *);
2010 static bool read_compressed_number (struct sfm_reader *, double *);
2011 static bool read_compressed_string (struct sfm_reader *, uint8_t *);
2012 static bool read_whole_strings (struct sfm_reader *, uint8_t *, size_t);
2013 static bool skip_whole_strings (struct sfm_reader *, size_t);
2014
2015 /* Reads and returns one case from READER's file.  Returns a null
2016    pointer if not successful. */
2017 static struct ccase *
2018 sys_file_casereader_read (struct casereader *reader, void *r_)
2019 {
2020   struct sfm_reader *r = r_;
2021   struct ccase *volatile c;
2022   int i;
2023
2024   if (r->error)
2025     return NULL;
2026
2027   c = case_create (r->proto);
2028   if (setjmp (r->bail_out))
2029     {
2030       casereader_force_error (reader);
2031       case_unref (c);
2032       return NULL;
2033     }
2034
2035   for (i = 0; i < r->sfm_var_cnt; i++)
2036     {
2037       struct sfm_var *sv = &r->sfm_vars[i];
2038       union value *v = case_data_rw_idx (c, sv->case_index);
2039
2040       if (sv->var_width == 0)
2041         {
2042           if (!read_case_number (r, &v->f))
2043             goto eof;
2044         }
2045       else
2046         {
2047           uint8_t *s = value_str_rw (v, sv->var_width);
2048           if (!read_case_string (r, s + sv->offset, sv->segment_width))
2049             goto eof;
2050           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
2051             partial_record (r);
2052         }
2053     }
2054   return c;
2055
2056 eof:
2057   if (i != 0)
2058     partial_record (r);
2059   if (r->case_cnt != -1)
2060     read_error (reader, r);
2061   case_unref (c);
2062   return NULL;
2063 }
2064
2065 /* Issues an error that R ends in a partial record. */
2066 static void
2067 partial_record (struct sfm_reader *r)
2068 {
2069   sys_error (r, r->pos, _("File ends in partial case."));
2070 }
2071
2072 /* Issues an error that an unspecified error occurred SFM, and
2073    marks R tainted. */
2074 static void
2075 read_error (struct casereader *r, const struct sfm_reader *sfm)
2076 {
2077   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
2078   casereader_force_error (r);
2079 }
2080
2081 /* Reads a number from R and stores its value in *D.
2082    If R is compressed, reads a compressed number;
2083    otherwise, reads a number in the regular way.
2084    Returns true if successful, false if end of file is
2085    reached immediately. */
2086 static bool
2087 read_case_number (struct sfm_reader *r, double *d)
2088 {
2089   if (!r->compressed)
2090     {
2091       uint8_t number[8];
2092       if (!try_read_bytes (r, number, sizeof number))
2093         return false;
2094       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
2095       return true;
2096     }
2097   else
2098     return read_compressed_number (r, d);
2099 }
2100
2101 /* Reads LENGTH string bytes from R into S.
2102    Always reads a multiple of 8 bytes; if LENGTH is not a
2103    multiple of 8, then extra bytes are read and discarded without
2104    being written to S.
2105    Reads compressed strings if S is compressed.
2106    Returns true if successful, false if end of file is
2107    reached immediately. */
2108 static bool
2109 read_case_string (struct sfm_reader *r, uint8_t *s, size_t length)
2110 {
2111   size_t whole = ROUND_DOWN (length, 8);
2112   size_t partial = length % 8;
2113
2114   if (whole)
2115     {
2116       if (!read_whole_strings (r, s, whole))
2117         return false;
2118     }
2119
2120   if (partial)
2121     {
2122       uint8_t bounce[8];
2123       if (!read_whole_strings (r, bounce, sizeof bounce))
2124         {
2125           if (whole)
2126             partial_record (r);
2127           return false;
2128         }
2129       memcpy (s + whole, bounce, partial);
2130     }
2131
2132   return true;
2133 }
2134
2135 /* Reads and returns the next compression opcode from R. */
2136 static int
2137 read_opcode (struct sfm_reader *r)
2138 {
2139   assert (r->compressed);
2140   for (;;)
2141     {
2142       int opcode;
2143       if (r->opcode_idx >= sizeof r->opcodes)
2144         {
2145           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
2146             return -1;
2147           r->opcode_idx = 0;
2148         }
2149       opcode = r->opcodes[r->opcode_idx++];
2150
2151       if (opcode != 0)
2152         return opcode;
2153     }
2154 }
2155
2156 /* Reads a compressed number from R and stores its value in D.
2157    Returns true if successful, false if end of file is
2158    reached immediately. */
2159 static bool
2160 read_compressed_number (struct sfm_reader *r, double *d)
2161 {
2162   int opcode = read_opcode (r);
2163   switch (opcode)
2164     {
2165     case -1:
2166     case 252:
2167       return false;
2168
2169     case 253:
2170       *d = read_float (r);
2171       break;
2172
2173     case 254:
2174       float_convert (r->float_format, "        ", FLOAT_NATIVE_DOUBLE, d);
2175       if (!r->corruption_warning)
2176         {
2177           r->corruption_warning = true;
2178           sys_warn (r, r->pos,
2179                     _("Possible compressed data corruption: "
2180                       "compressed spaces appear in numeric field."));
2181         }
2182       break;
2183
2184     case 255:
2185       *d = SYSMIS;
2186       break;
2187
2188     default:
2189       *d = opcode - r->bias;
2190       break;
2191     }
2192
2193   return true;
2194 }
2195
2196 /* Reads a compressed 8-byte string segment from R and stores it
2197    in DST.
2198    Returns true if successful, false if end of file is
2199    reached immediately. */
2200 static bool
2201 read_compressed_string (struct sfm_reader *r, uint8_t *dst)
2202 {
2203   int opcode = read_opcode (r);
2204   switch (opcode)
2205     {
2206     case -1:
2207     case 252:
2208       return false;
2209
2210     case 253:
2211       read_bytes (r, dst, 8);
2212       break;
2213
2214     case 254:
2215       memset (dst, ' ', 8);
2216       break;
2217
2218     default:
2219       {
2220         double value = opcode - r->bias;
2221         float_convert (FLOAT_NATIVE_DOUBLE, &value, r->float_format, dst);
2222         if (value == 0.0)
2223           {
2224             /* This has actually been seen "in the wild".  The submitter of the
2225                file that showed that the contents decoded as spaces, but they
2226                were at the end of the field so it's possible that the null
2227                bytes just acted as null terminators. */
2228           }
2229         else if (!r->corruption_warning)
2230           {
2231             r->corruption_warning = true;
2232             sys_warn (r, r->pos,
2233                       _("Possible compressed data corruption: "
2234                         "string contains compressed integer (opcode %d)."),
2235                       opcode);
2236           }
2237       }
2238       break;
2239     }
2240
2241   return true;
2242 }
2243
2244 /* Reads LENGTH string bytes from R into S.
2245    LENGTH must be a multiple of 8.
2246    Reads compressed strings if S is compressed.
2247    Returns true if successful, false if end of file is
2248    reached immediately. */
2249 static bool
2250 read_whole_strings (struct sfm_reader *r, uint8_t *s, size_t length)
2251 {
2252   assert (length % 8 == 0);
2253   if (!r->compressed)
2254     return try_read_bytes (r, s, length);
2255   else
2256     {
2257       size_t ofs;
2258       for (ofs = 0; ofs < length; ofs += 8)
2259         if (!read_compressed_string (r, s + ofs))
2260           {
2261             if (ofs != 0)
2262               partial_record (r);
2263             return false;
2264           }
2265       return true;
2266     }
2267 }
2268
2269 /* Skips LENGTH string bytes from R.
2270    LENGTH must be a multiple of 8.
2271    (LENGTH is also limited to 1024, but that's only because the
2272    current caller never needs more than that many bytes.)
2273    Returns true if successful, false if end of file is
2274    reached immediately. */
2275 static bool
2276 skip_whole_strings (struct sfm_reader *r, size_t length)
2277 {
2278   uint8_t buffer[1024];
2279   assert (length < sizeof buffer);
2280   return read_whole_strings (r, buffer, length);
2281 }
2282 \f
2283 /* Helpers for reading records that contain structured text
2284    strings. */
2285
2286 /* Maximum number of warnings to issue for a single text
2287    record. */
2288 #define MAX_TEXT_WARNINGS 5
2289
2290 /* State. */
2291 struct text_record
2292   {
2293     struct substring buffer;    /* Record contents. */
2294     off_t start;                /* Starting offset in file. */
2295     size_t pos;                 /* Current position in buffer. */
2296     int n_warnings;             /* Number of warnings issued or suppressed. */
2297     bool recoded;               /* Recoded into UTF-8? */
2298   };
2299
2300 static struct text_record *
2301 open_text_record (struct sfm_reader *r,
2302                   const struct sfm_extension_record *record,
2303                   bool recode_to_utf8)
2304 {
2305   struct text_record *text;
2306   struct substring raw;
2307
2308   text = pool_alloc (r->pool, sizeof *text);
2309   raw = ss_buffer (record->data, record->size * record->count);
2310   text->start = record->pos;
2311   text->buffer = (recode_to_utf8
2312                   ? recode_substring_pool ("UTF-8", r->encoding, raw, r->pool)
2313                   : raw);
2314   text->pos = 0;
2315   text->n_warnings = 0;
2316   text->recoded = recode_to_utf8;
2317
2318   return text;
2319 }
2320
2321 /* Closes TEXT, frees its storage, and issues a final warning
2322    about suppressed warnings if necesary. */
2323 static void
2324 close_text_record (struct sfm_reader *r, struct text_record *text)
2325 {
2326   if (text->n_warnings > MAX_TEXT_WARNINGS)
2327     sys_warn (r, -1, _("Suppressed %d additional related warnings."),
2328               text->n_warnings - MAX_TEXT_WARNINGS);
2329   if (text->recoded)
2330     pool_free (r->pool, ss_data (text->buffer));
2331 }
2332
2333 /* Reads a variable=value pair from TEXT.
2334    Looks up the variable in DICT and stores it into *VAR.
2335    Stores a null-terminated value into *VALUE. */
2336 static bool
2337 read_variable_to_value_pair (struct sfm_reader *r, struct dictionary *dict,
2338                              struct text_record *text,
2339                              struct variable **var, char **value)
2340 {
2341   for (;;)
2342     {
2343       if (!text_read_short_name (r, dict, text, ss_cstr ("="), var))
2344         return false;
2345       
2346       *value = text_get_token (text, ss_buffer ("\t\0", 2), NULL);
2347       if (*value == NULL)
2348         return false;
2349
2350       text->pos += ss_span (ss_substr (text->buffer, text->pos, SIZE_MAX),
2351                             ss_buffer ("\t\0", 2));
2352
2353       if (*var != NULL)
2354         return true;
2355     }
2356 }
2357
2358 static bool
2359 text_read_variable_name (struct sfm_reader *r, struct dictionary *dict,
2360                          struct text_record *text, struct substring delimiters,
2361                          struct variable **var)
2362 {
2363   char *name;
2364
2365   name = text_get_token (text, delimiters, NULL);
2366   if (name == NULL)
2367     return false;
2368
2369   *var = dict_lookup_var (dict, name);
2370   if (*var != NULL)
2371     return true;
2372
2373   text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2374              name);
2375   return false;
2376 }
2377
2378
2379 static bool
2380 text_read_short_name (struct sfm_reader *r, struct dictionary *dict,
2381                       struct text_record *text, struct substring delimiters,
2382                       struct variable **var)
2383 {
2384   char *short_name = text_get_token (text, delimiters, NULL);
2385   if (short_name == NULL)
2386     return false;
2387
2388   *var = dict_lookup_var (dict, short_name);
2389   if (*var == NULL)
2390     text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2391                short_name);
2392   return true;
2393 }
2394
2395 /* Displays a warning for the current file position, limiting the
2396    number to MAX_TEXT_WARNINGS for TEXT. */
2397 static void
2398 text_warn (struct sfm_reader *r, struct text_record *text,
2399            const char *format, ...)
2400 {
2401   if (text->n_warnings++ < MAX_TEXT_WARNINGS) 
2402     {
2403       va_list args;
2404
2405       va_start (args, format);
2406       sys_msg (r, text->start + text->pos, MW, format, args);
2407       va_end (args);
2408     }
2409 }
2410
2411 static char *
2412 text_get_token (struct text_record *text, struct substring delimiters,
2413                 char *delimiter)
2414 {
2415   struct substring token;
2416   char *end;
2417
2418   if (!ss_tokenize (text->buffer, delimiters, &text->pos, &token))
2419     return NULL;
2420
2421   end = &ss_data (token)[ss_length (token)];
2422   if (delimiter != NULL)
2423     *delimiter = *end;
2424   *end = '\0';
2425   return ss_data (token);
2426 }
2427
2428 /* Reads a integer value expressed in decimal, then a space, then a string that
2429    consists of exactly as many bytes as specified by the integer, then a space,
2430    from TEXT.  Returns the string, null-terminated, as a subset of TEXT's
2431    buffer (so the caller should not free the string). */
2432 static const char *
2433 text_parse_counted_string (struct sfm_reader *r, struct text_record *text)
2434 {
2435   size_t start;
2436   size_t n;
2437   char *s;
2438
2439   start = text->pos;
2440   n = 0;
2441   while (text->pos < text->buffer.length)
2442     {
2443       int c = text->buffer.string[text->pos];
2444       if (c < '0' || c > '9')
2445         break;
2446       n = (n * 10) + (c - '0');
2447       text->pos++;
2448     }
2449   if (text->pos >= text->buffer.length || start == text->pos)
2450     {
2451       sys_warn (r, text->start,
2452                 _("Expecting digit at offset %zu in MRSETS record."),
2453                 text->pos);
2454       return NULL;
2455     }
2456
2457   if (!text_match (text, ' '))
2458     {
2459       sys_warn (r, text->start,
2460                 _("Expecting space at offset %zu in MRSETS record."),
2461                 text->pos);
2462       return NULL;
2463     }
2464
2465   if (text->pos + n > text->buffer.length)
2466     {
2467       sys_warn (r, text->start,
2468                 _("%zu-byte string starting at offset %zu "
2469                   "exceeds record length %zu."),
2470                 n, text->pos, text->buffer.length);
2471       return NULL;
2472     }
2473
2474   s = &text->buffer.string[text->pos];
2475   if (s[n] != ' ')
2476     {
2477       sys_warn (r, text->start,
2478                 _("Expecting space at offset %zu following %zu-byte string."),
2479                 text->pos + n, n);
2480       return NULL;
2481     }
2482   s[n] = '\0';
2483   text->pos += n + 1;
2484   return s;
2485 }
2486
2487 static bool
2488 text_match (struct text_record *text, char c)
2489 {
2490   if (text->buffer.string[text->pos] == c) 
2491     {
2492       text->pos++;
2493       return true;
2494     }
2495   else
2496     return false;
2497 }
2498
2499 /* Returns the current byte offset (as converted to UTF-8, if it was converted)
2500    inside the TEXT's string. */
2501 static size_t
2502 text_pos (const struct text_record *text)
2503 {
2504   return text->pos;
2505 }
2506 \f
2507 /* Messages. */
2508
2509 /* Displays a corruption message. */
2510 static void
2511 sys_msg (struct sfm_reader *r, off_t offset,
2512          int class, const char *format, va_list args)
2513 {
2514   struct msg m;
2515   struct string text;
2516
2517   ds_init_empty (&text);
2518   if (offset >= 0)
2519     ds_put_format (&text, _("`%s' near offset 0x%llx: "),
2520                    fh_get_file_name (r->fh), (long long int) offset);
2521   else
2522     ds_put_format (&text, _("`%s': "), fh_get_file_name (r->fh));
2523   ds_put_vformat (&text, format, args);
2524
2525   m.category = msg_class_to_category (class);
2526   m.severity = msg_class_to_severity (class);
2527   m.file_name = NULL;
2528   m.first_line = 0;
2529   m.last_line = 0;
2530   m.first_column = 0;
2531   m.last_column = 0;
2532   m.text = ds_cstr (&text);
2533
2534   msg_emit (&m);
2535 }
2536
2537 /* Displays a warning for offset OFFSET in the file. */
2538 static void
2539 sys_warn (struct sfm_reader *r, off_t offset, const char *format, ...)
2540 {
2541   va_list args;
2542
2543   va_start (args, format);
2544   sys_msg (r, offset, MW, format, args);
2545   va_end (args);
2546 }
2547
2548 /* Displays an error for the current file position,
2549    marks it as in an error state,
2550    and aborts reading it using longjmp. */
2551 static void
2552 sys_error (struct sfm_reader *r, off_t offset, const char *format, ...)
2553 {
2554   va_list args;
2555
2556   va_start (args, format);
2557   sys_msg (r, offset, ME, format, args);
2558   va_end (args);
2559
2560   r->error = true;
2561   longjmp (r->bail_out, 1);
2562 }
2563 \f
2564 /* Reads BYTE_CNT bytes into BUF.
2565    Returns true if exactly BYTE_CNT bytes are successfully read.
2566    Aborts if an I/O error or a partial read occurs.
2567    If EOF_IS_OK, then an immediate end-of-file causes false to be
2568    returned; otherwise, immediate end-of-file causes an abort
2569    too. */
2570 static inline bool
2571 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
2572                    void *buf, size_t byte_cnt)
2573 {
2574   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
2575   r->pos += bytes_read;
2576   if (bytes_read == byte_cnt)
2577     return true;
2578   else if (ferror (r->file))
2579     sys_error (r, r->pos, _("System error: %s."), strerror (errno));
2580   else if (!eof_is_ok || bytes_read != 0)
2581     sys_error (r, r->pos, _("Unexpected end of file."));
2582   else
2583     return false;
2584 }
2585
2586 /* Reads BYTE_CNT into BUF.
2587    Aborts upon I/O error or if end-of-file is encountered. */
2588 static void
2589 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2590 {
2591   read_bytes_internal (r, false, buf, byte_cnt);
2592 }
2593
2594 /* Reads BYTE_CNT bytes into BUF.
2595    Returns true if exactly BYTE_CNT bytes are successfully read.
2596    Returns false if an immediate end-of-file is encountered.
2597    Aborts if an I/O error or a partial read occurs. */
2598 static bool
2599 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2600 {
2601   return read_bytes_internal (r, true, buf, byte_cnt);
2602 }
2603
2604 /* Reads a 32-bit signed integer from R and returns its value in
2605    host format. */
2606 static int
2607 read_int (struct sfm_reader *r)
2608 {
2609   uint8_t integer[4];
2610   read_bytes (r, integer, sizeof integer);
2611   return integer_get (r->integer_format, integer, sizeof integer);
2612 }
2613
2614 /* Reads a 64-bit floating-point number from R and returns its
2615    value in host format. */
2616 static double
2617 read_float (struct sfm_reader *r)
2618 {
2619   uint8_t number[8];
2620   read_bytes (r, number, sizeof number);
2621   return float_get_double (r->float_format, number);
2622 }
2623
2624 static int
2625 parse_int (struct sfm_reader *r, const void *data, size_t ofs)
2626 {
2627   return integer_get (r->integer_format, (const uint8_t *) data + ofs, 4);
2628 }
2629
2630 static double
2631 parse_float (struct sfm_reader *r, const void *data, size_t ofs)
2632 {
2633   return float_get_double (r->float_format, (const uint8_t *) data + ofs);
2634 }
2635
2636 /* Reads exactly SIZE - 1 bytes into BUFFER
2637    and stores a null byte into BUFFER[SIZE - 1]. */
2638 static void
2639 read_string (struct sfm_reader *r, char *buffer, size_t size)
2640 {
2641   assert (size > 0);
2642   read_bytes (r, buffer, size - 1);
2643   buffer[size - 1] = '\0';
2644 }
2645
2646 /* Skips BYTES bytes forward in R. */
2647 static void
2648 skip_bytes (struct sfm_reader *r, size_t bytes)
2649 {
2650   while (bytes > 0)
2651     {
2652       char buffer[1024];
2653       size_t chunk = MIN (sizeof buffer, bytes);
2654       read_bytes (r, buffer, chunk);
2655       bytes -= chunk;
2656     }
2657 }
2658 \f
2659 static const struct casereader_class sys_file_casereader_class =
2660   {
2661     sys_file_casereader_read,
2662     sys_file_casereader_destroy,
2663     NULL,
2664     NULL,
2665   };