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