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