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