sys-file-reader: Elevate invalid number of labels from warning to error.
[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   /* Identify floating-point format and obtain compression bias. */
517   read_bytes (r, raw_bias, sizeof raw_bias);
518   if (float_identify (100.0, raw_bias, sizeof raw_bias, &r->float_format) == 0)
519     {
520       uint8_t zero_bias[8] = { 0, 0, 0, 0, 0, 0, 0, 0 };
521
522       if (memcmp (raw_bias, zero_bias, 8))
523         sys_warn (r, _("Compression bias is not the usual "
524                        "value of 100, or system file uses unrecognized "
525                        "floating-point format."));
526       else
527         {
528           /* Some software is known to write all-zeros to this
529              field.  Such software also writes floating-point
530              numbers in the format that we expect by default
531              (it seems that all software most likely does, in
532              reality), so don't warn in this case. */
533         }
534
535       if (r->integer_format == INTEGER_MSB_FIRST)
536         r->float_format = FLOAT_IEEE_DOUBLE_BE;
537       else
538         r->float_format = FLOAT_IEEE_DOUBLE_LE;
539     }
540   float_convert (r->float_format, raw_bias, FLOAT_NATIVE_DOUBLE, &r->bias);
541
542   read_string (r, creation_date, sizeof creation_date);
543   read_string (r, creation_time, sizeof creation_time);
544   read_string (r, file_label, sizeof file_label);
545   skip_bytes (r, 3);
546
547   file_label_ss = ss_cstr (file_label);
548   ss_trim (&file_label_ss, ss_cstr (" "));
549   if (!ss_is_empty (file_label_ss))
550     {
551       ss_data (file_label_ss)[ss_length (file_label_ss)] = '\0';
552       dict_set_label (dict, ss_data (file_label_ss));
553     }
554
555   strcpy (info->creation_date, creation_date);
556   strcpy (info->creation_time, creation_time);
557   info->integer_format = r->integer_format;
558   info->float_format = r->float_format;
559   info->compressed = r->compressed;
560   info->case_cnt = r->case_cnt;
561
562   product = ss_cstr (eye_catcher);
563   ss_match_string (&product, ss_cstr ("@(#) SPSS DATA FILE"));
564   ss_trim (&product, ss_cstr (" "));
565   str_copy_buf_trunc (info->product, sizeof info->product,
566                       ss_data (product), ss_length (product));
567 }
568
569 /* Reads a variable (type 2) record from R and adds the
570    corresponding variable to DICT.
571    Also skips past additional variable records for long string
572    variables. */
573 static void
574 read_variable_record (struct sfm_reader *r, struct dictionary *dict,
575                       int *format_warning_cnt)
576 {
577   int width;
578   int has_variable_label;
579   int missing_value_code;
580   int print_format;
581   int write_format;
582   char name[9];
583
584   struct variable *var;
585   int nv;
586
587   width = read_int (r);
588   has_variable_label = read_int (r);
589   missing_value_code = read_int (r);
590   print_format = read_int (r);
591   write_format = read_int (r);
592   read_string (r, name, sizeof name);
593   name[strcspn (name, " ")] = '\0';
594
595   /* Check variable name. */
596   if (name[0] == '$' || name[0] == '#')
597     sys_error (r, _("Variable name begins with invalid character `%c'."),
598                name[0]);
599   if (!var_is_plausible_name (name, false))
600     sys_error (r, _("Invalid variable name `%s'."), name);
601
602   /* Create variable. */
603   if (width < 0 || width > 255)
604     sys_error (r, _("Bad width %d for variable %s."), width, name);
605   var = dict_create_var (dict, name, width);
606   if (var == NULL)
607     sys_error (r, _("Duplicate variable name `%s'."), 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                         "(not string variable `%s')."),
774                    var_get_name (weight_var));
775     }
776 }
777
778 /* Reads a document record, type 6, from system file R, and sets up
779    the documents and n_documents fields in the associated
780    dictionary. */
781 static void
782 read_documents (struct sfm_reader *r, struct dictionary *dict)
783 {
784   int line_cnt;
785   char *documents;
786
787   if (dict_get_documents (dict) != NULL)
788     sys_error (r, _("Multiple type 6 (document) records."));
789
790   line_cnt = read_int (r);
791   if (line_cnt <= 0)
792     sys_error (r, _("Number of document lines (%d) "
793                     "must be greater than 0."), line_cnt);
794
795   documents = pool_nmalloc (r->pool, line_cnt + 1, DOC_LINE_LENGTH);
796   read_string (r, documents, DOC_LINE_LENGTH * line_cnt + 1);
797   if (strlen (documents) == DOC_LINE_LENGTH * line_cnt)
798     dict_set_documents (dict, documents);
799   else
800     sys_error (r, _("Document line contains null byte."));
801   pool_free (r->pool, documents);
802 }
803
804 /* Read a type 7 extension record. */
805 static void
806 read_extension_record (struct sfm_reader *r, struct dictionary *dict,
807                        struct sfm_read_info *info)
808 {
809   int subtype = read_int (r);
810   size_t size = read_int (r);
811   size_t count = read_int (r);
812   size_t bytes = size * count;
813
814   /* Check that SIZE * COUNT + 1 doesn't overflow.  Adding 1
815      allows an extra byte for a null terminator, used by some
816      extension processing routines. */
817   if (size != 0 && size_overflow_p (xsum (1, xtimes (count, size))))
818     sys_error (r, "Record type 7 subtype %d too large.", subtype);
819
820   switch (subtype)
821     {
822     case 3:
823       read_machine_integer_info (r, size, count, info, dict);
824       return;
825
826     case 4:
827       read_machine_float_info (r, size, count);
828       return;
829
830     case 5:
831       /* Variable sets information.  We don't use these yet.
832          They only apply to GUIs; see VARSETS on the APPLY
833          DICTIONARY command in SPSS documentation. */
834       break;
835
836     case 6:
837       /* DATE variable information.  We don't use it yet, but we
838          should. */
839       break;
840
841     case 7:
842     case 19:
843       read_mrsets (r, size, count, dict);
844       return;
845
846     case 8:
847       /* Used by the SPSS Data Entry software. */
848       break;
849
850     case 11:
851       read_display_parameters (r, size, count, dict);
852       return;
853
854     case 13:
855       read_long_var_name_map (r, size, count, dict);
856       return;
857
858     case 14:
859       read_long_string_map (r, size, count, dict);
860       return;
861
862     case 16:
863       /* Extended number of cases.  Not important. */
864       break;
865
866     case 17:
867       read_data_file_attributes (r, size, count, dict);
868       return;
869
870     case 18:
871       read_variable_attributes (r, size, count, dict);
872       return;
873
874     case 20:
875       /* New in SPSS 16.  Contains a single string that describes
876          the character encoding, e.g. "windows-1252". */
877       {
878         char *encoding = pool_calloc (r->pool, size, count + 1);
879         read_string (r, encoding, count + 1);
880         dict_set_encoding (dict, encoding);
881         return;
882       }
883
884     case 21:
885       /* New in SPSS 16.  Encodes value labels for long string
886          variables. */
887       read_long_string_value_labels (r, size, count, dict);
888       return;
889
890     default:
891       sys_warn (r, _("Unrecognized record type 7, subtype %d.  Please send "
892                      "a copy of this file, and the syntax which created it "
893                      "to %s."),
894                 subtype, PACKAGE_BUGREPORT);
895       break;
896     }
897
898   skip_bytes (r, bytes);
899 }
900
901 /* Read record type 7, subtype 3. */
902 static void
903 read_machine_integer_info (struct sfm_reader *r, size_t size, size_t count,
904                            struct sfm_read_info *info,
905                            struct dictionary *dict)
906 {
907   int version_major = read_int (r);
908   int version_minor = read_int (r);
909   int version_revision = read_int (r);
910   int machine_code UNUSED = read_int (r);
911   int float_representation = read_int (r);
912   int compression_code UNUSED = read_int (r);
913   int integer_representation = read_int (r);
914   int character_code = read_int (r);
915
916   int expected_float_format;
917   int expected_integer_format;
918
919   if (size != 4 || count != 8)
920     sys_error (r, _("Bad size (%zu) or count (%zu) field on record type 7, "
921                     "subtype 3."),
922                 size, count);
923
924   /* Save version info. */
925   info->version_major = version_major;
926   info->version_minor = version_minor;
927   info->version_revision = version_revision;
928
929   /* Check floating point format. */
930   if (r->float_format == FLOAT_IEEE_DOUBLE_BE
931       || r->float_format == FLOAT_IEEE_DOUBLE_LE)
932     expected_float_format = 1;
933   else if (r->float_format == FLOAT_Z_LONG)
934     expected_float_format = 2;
935   else if (r->float_format == FLOAT_VAX_G || r->float_format == FLOAT_VAX_D)
936     expected_float_format = 3;
937   else
938     NOT_REACHED ();
939   if (float_representation != expected_float_format)
940     sys_error (r, _("Floating-point representation indicated by "
941                     "system file (%d) differs from expected (%d)."),
942               float_representation, expected_float_format);
943
944   /* Check integer format. */
945   if (r->integer_format == INTEGER_MSB_FIRST)
946     expected_integer_format = 1;
947   else if (r->integer_format == INTEGER_LSB_FIRST)
948     expected_integer_format = 2;
949   else
950     NOT_REACHED ();
951   if (integer_representation != expected_integer_format)
952     sys_warn (r, _("Integer format indicated by system file (%d) "
953                    "differs from expected (%d)."),
954               integer_representation, expected_integer_format);
955
956   /*
957     Record 7 (20) provides a much more reliable way of
958     setting the encoding.
959     The character_code is used as a fallback only.
960   */
961   if ( NULL == dict_get_encoding (dict))
962     {
963       switch (character_code)
964         {
965         case 1:
966           dict_set_encoding (dict, "EBCDIC-US");
967           break;
968         case 2:
969         case 3:
970           /* These ostensibly mean "7-bit ASCII" and "8-bit ASCII"[sic]
971              respectively.   However, there are known to be many files
972              in the wild with character code 2, yet have data which are
973              clearly not ascii.
974              Therefore we ignore these values.
975           */
976           return;
977         case 4:
978           dict_set_encoding (dict, "MS_KANJI");
979           break;
980         case 65000:
981           dict_set_encoding (dict, "UTF-7");
982           break;
983         case 65001:
984           dict_set_encoding (dict, "UTF-8");
985           break;
986         default:
987           {
988             char enc[100];
989             snprintf (enc, 100, "CP%d", character_code);
990             dict_set_encoding (dict, enc);
991           }
992           break;
993         };
994     }
995 }
996
997 /* Read record type 7, subtype 4. */
998 static void
999 read_machine_float_info (struct sfm_reader *r, size_t size, size_t count)
1000 {
1001   double sysmis = read_float (r);
1002   double highest = read_float (r);
1003   double lowest = read_float (r);
1004
1005   if (size != 8 || count != 3)
1006     sys_error (r, _("Bad size (%zu) or count (%zu) on extension 4."),
1007                size, count);
1008
1009   if (sysmis != SYSMIS)
1010     sys_warn (r, _("File specifies unexpected value %g as %s."),
1011               sysmis, "SYSMIS");
1012
1013   if (highest != HIGHEST)
1014     sys_warn (r, _("File specifies unexpected value %g as %s."),
1015               highest, "HIGHEST");
1016
1017   if (lowest != LOWEST)
1018     sys_warn (r, _("File specifies unexpected value %g as %s."),
1019               lowest, "LOWEST");
1020 }
1021
1022 /* Read record type 7, subtype 7 or 19. */
1023 static void
1024 read_mrsets (struct sfm_reader *r, size_t size, size_t count,
1025              struct dictionary *dict)
1026 {
1027   struct text_record *text;
1028   struct mrset *mrset;
1029
1030   text = open_text_record (r, size * count);
1031   for (;;)
1032     {
1033       const char *name, *label, *counted;
1034       struct stringi_set var_names;
1035       size_t allocated_vars;
1036       char delimiter;
1037       int width;
1038
1039       mrset = xzalloc (sizeof *mrset);
1040
1041       name = text_get_token (text, ss_cstr ("="), NULL);
1042       if (name == NULL)
1043         break;
1044       mrset->name = xstrdup (name);
1045
1046       if (mrset->name[0] != '$')
1047         {
1048           sys_warn (r, _("`%s' does not begin with `$' at offset %zu "
1049                          "in MRSETS record."), mrset->name, text_pos (text));
1050           break;
1051         }
1052
1053       if (text_match (text, 'C'))
1054         {
1055           mrset->type = MRSET_MC;
1056           if (!text_match (text, ' '))
1057             {
1058               sys_warn (r, _("Missing space following `%c' at offset %zu "
1059                              "in MRSETS record."), 'C', text_pos (text));
1060               break;
1061             }
1062         }
1063       else if (text_match (text, 'D'))
1064         {
1065           mrset->type = MRSET_MD;
1066           mrset->cat_source = MRSET_VARLABELS;
1067         }
1068       else if (text_match (text, 'E'))
1069         {
1070           char *number;
1071
1072           mrset->type = MRSET_MD;
1073           mrset->cat_source = MRSET_COUNTEDVALUES;
1074           if (!text_match (text, ' '))
1075             {
1076               sys_warn (r, _("Missing space following `%c' at offset %zu "
1077                              "in MRSETS record."), 'E',  text_pos (text));
1078               break;
1079             }
1080
1081           number = text_get_token (text, ss_cstr (" "), NULL);
1082           if (!strcmp (number, "11"))
1083             mrset->label_from_var_label = true;
1084           else if (strcmp (number, "1"))
1085             sys_warn (r, _("Unexpected label source value `%s' "
1086                            "following `E' at offset %zu in MRSETS record."),
1087                       number, text_pos (text));
1088         }
1089       else
1090         {
1091           sys_warn (r, _("Missing `C', `D', or `E' at offset %zu "
1092                          "in MRSETS record."),
1093                     text_pos (text));
1094           break;
1095         }
1096
1097       if (mrset->type == MRSET_MD)
1098         {
1099           counted = text_parse_counted_string (r, text);
1100           if (counted == NULL)
1101             break;
1102         }
1103
1104       label = text_parse_counted_string (r, text);
1105       if (label == NULL)
1106         break;
1107       mrset->label = label[0] != '\0' ? xstrdup (label) : NULL;
1108
1109       stringi_set_init (&var_names);
1110       allocated_vars = 0;
1111       width = INT_MAX;
1112       do
1113         {
1114           struct variable *var;
1115           const char *var_name;
1116
1117           var_name = text_get_token (text, ss_cstr (" \n"), &delimiter);
1118           if (var_name == NULL)
1119             {
1120               sys_warn (r, _("Missing new-line parsing variable names "
1121                              "at offset %zu in MRSETS record."),
1122                         text_pos (text));
1123               break;
1124             }
1125
1126           var = lookup_var_by_short_name (dict, var_name);
1127           if (var == NULL)
1128             continue;
1129           if (!stringi_set_insert (&var_names, var_name))
1130             {
1131               sys_warn (r, _("Duplicate variable name %s "
1132                              "at offset %zu in MRSETS record."),
1133                         var_name, text_pos (text));
1134               continue;
1135             }
1136
1137           if (mrset->label == NULL && mrset->label_from_var_label
1138               && var_has_label (var))
1139             mrset->label = xstrdup (var_get_label (var));
1140
1141           if (mrset->n_vars
1142               && var_get_type (var) != var_get_type (mrset->vars[0]))
1143             {
1144               sys_warn (r, _("MRSET %s contains both string and "
1145                              "numeric variables."), name);
1146               continue;
1147             }
1148           width = MIN (width, var_get_width (var));
1149
1150           if (mrset->n_vars >= allocated_vars)
1151             mrset->vars = x2nrealloc (mrset->vars, &allocated_vars,
1152                                       sizeof *mrset->vars);
1153           mrset->vars[mrset->n_vars++] = var;
1154         }
1155       while (delimiter != '\n');
1156
1157       if (mrset->n_vars < 2)
1158         {
1159           sys_warn (r, _("MRSET %s has only %zu variables."), mrset->name,
1160                     mrset->n_vars);
1161           mrset_destroy (mrset);
1162           continue;
1163         }
1164
1165       if (mrset->type == MRSET_MD)
1166         {
1167           mrset->width = width;
1168           value_init (&mrset->counted, width);
1169           if (width == 0)
1170             mrset->counted.f = strtod (counted, NULL);
1171           else
1172             value_copy_str_rpad (&mrset->counted, width,
1173                                  (const uint8_t *) counted, ' ');
1174         }
1175
1176       dict_add_mrset (dict, mrset);
1177       mrset = NULL;
1178       stringi_set_destroy (&var_names);
1179     }
1180   mrset_destroy (mrset);
1181   close_text_record (r, text);
1182 }
1183
1184 /* Read record type 7, subtype 11, which specifies how variables
1185    should be displayed in GUI environments. */
1186 static void
1187 read_display_parameters (struct sfm_reader *r, size_t size, size_t count,
1188                          struct dictionary *dict)
1189 {
1190   size_t n_vars;
1191   bool includes_width;
1192   bool warned = false;
1193   size_t i;
1194
1195   if (size != 4)
1196     {
1197       sys_warn (r, _("Bad size %zu on extension 11."), size);
1198       skip_bytes (r, size * count);
1199       return;
1200     }
1201
1202   n_vars = dict_get_var_cnt (dict);
1203   if (count == 3 * n_vars)
1204     includes_width = true;
1205   else if (count == 2 * n_vars)
1206     includes_width = false;
1207   else
1208     {
1209       sys_warn (r, _("Extension 11 has bad count %zu (for %zu variables)."),
1210                 count, n_vars);
1211       skip_bytes (r, size * count);
1212       return;
1213     }
1214
1215   for (i = 0; i < n_vars; ++i)
1216     {
1217       struct variable *v = dict_get_var (dict, i);
1218       int measure = read_int (r);
1219       int width = includes_width ? read_int (r) : 0;
1220       int align = read_int (r);
1221
1222       /* SPSS 14 sometimes seems to set string variables' measure
1223          to zero. */
1224       if (0 == measure && var_is_alpha (v))
1225         measure = 1;
1226
1227       if (measure < 1 || measure > 3 || align < 0 || align > 2)
1228         {
1229           if (!warned)
1230             sys_warn (r, _("Invalid variable display parameters "
1231                            "for variable %zu (%s).  "
1232                            "Default parameters substituted."),
1233                       i, var_get_name (v));
1234           warned = true;
1235           continue;
1236         }
1237
1238       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
1239                            : measure == 2 ? MEASURE_ORDINAL
1240                            : MEASURE_SCALE));
1241       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
1242                              : align == 1 ? ALIGN_RIGHT
1243                              : ALIGN_CENTRE));
1244
1245       /* Older versions (SPSS 9.0) sometimes set the display
1246          width to zero.  This causes confusion in the GUI, so
1247          only set the width if it is nonzero. */
1248       if (width > 0)
1249         var_set_display_width (v, width);
1250     }
1251 }
1252
1253 /* Reads record type 7, subtype 13, which gives the long name
1254    that corresponds to each short name.  Modifies variable names
1255    in DICT accordingly.  */
1256 static void
1257 read_long_var_name_map (struct sfm_reader *r, size_t size, size_t count,
1258                         struct dictionary *dict)
1259 {
1260   struct text_record *text;
1261   struct variable *var;
1262   char *long_name;
1263
1264   text = open_text_record (r, size * count);
1265   while (read_variable_to_value_pair (r, dict, text, &var, &long_name))
1266     {
1267       char **short_names;
1268       size_t short_name_cnt;
1269       size_t i;
1270
1271       /* Validate long name. */
1272       if (!var_is_valid_name (long_name, false))
1273         {
1274           sys_warn (r, _("Long variable mapping from %s to invalid "
1275                          "variable name `%s'."),
1276                     var_get_name (var), long_name);
1277           continue;
1278         }
1279
1280       /* Identify any duplicates. */
1281       if (strcasecmp (var_get_short_name (var, 0), long_name)
1282           && dict_lookup_var (dict, long_name) != NULL)
1283         {
1284           sys_warn (r, _("Duplicate long variable name `%s'."), long_name);
1285           continue;
1286         }
1287
1288       /* Renaming a variable may clear its short names, but we
1289          want to retain them, so we save them and re-set them
1290          afterward. */
1291       short_name_cnt = var_get_short_name_cnt (var);
1292       short_names = xnmalloc (short_name_cnt, sizeof *short_names);
1293       for (i = 0; i < short_name_cnt; i++)
1294         {
1295           const char *s = var_get_short_name (var, i);
1296           short_names[i] = s != NULL ? xstrdup (s) : NULL;
1297         }
1298
1299       /* Set long name. */
1300       dict_rename_var (dict, var, long_name);
1301
1302       /* Restore short names. */
1303       for (i = 0; i < short_name_cnt; i++)
1304         {
1305           var_set_short_name (var, i, short_names[i]);
1306           free (short_names[i]);
1307         }
1308       free (short_names);
1309     }
1310   close_text_record (r, text);
1311   r->has_long_var_names = true;
1312 }
1313
1314 /* Reads record type 7, subtype 14, which gives the real length
1315    of each very long string.  Rearranges DICT accordingly. */
1316 static void
1317 read_long_string_map (struct sfm_reader *r, size_t size, size_t count,
1318                       struct dictionary *dict)
1319 {
1320   struct text_record *text;
1321   struct variable *var;
1322   char *length_s;
1323
1324   text = open_text_record (r, size * count);
1325   while (read_variable_to_value_pair (r, dict, text, &var, &length_s))
1326     {
1327       size_t idx = var_get_dict_index (var);
1328       long int length;
1329       int segment_cnt;
1330       int i;
1331
1332       /* Get length. */
1333       length = strtol (length_s, NULL, 10);
1334       if (length < 1 || length > MAX_STRING)
1335         {
1336           sys_warn (r, _("%s listed as string of invalid length %s "
1337                          "in very long string record."),
1338                     var_get_name (var), length_s);
1339           continue;
1340         }
1341
1342       /* Check segments. */
1343       segment_cnt = sfm_width_to_segments (length);
1344       if (segment_cnt == 1)
1345         {
1346           sys_warn (r, _("%s listed in very long string record with width %s, "
1347                          "which requires only one segment."),
1348                     var_get_name (var), length_s);
1349           continue;
1350         }
1351       if (idx + segment_cnt > dict_get_var_cnt (dict))
1352         sys_error (r, _("Very long string %s overflows dictionary."),
1353                    var_get_name (var));
1354
1355       /* Get the short names from the segments and check their
1356          lengths. */
1357       for (i = 0; i < segment_cnt; i++)
1358         {
1359           struct variable *seg = dict_get_var (dict, idx + i);
1360           int alloc_width = sfm_segment_alloc_width (length, i);
1361           int width = var_get_width (seg);
1362
1363           if (i > 0)
1364             var_set_short_name (var, i, var_get_short_name (seg, 0));
1365           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
1366             sys_error (r, _("Very long string with width %ld has segment %d "
1367                             "of width %d (expected %d)."),
1368                        length, i, width, alloc_width);
1369         }
1370       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1371       var_set_width (var, length);
1372     }
1373   close_text_record (r, text);
1374   dict_compact_values (dict);
1375 }
1376
1377 /* Reads value labels from sysfile H and inserts them into the
1378    associated dictionary. */
1379 static void
1380 read_value_labels (struct sfm_reader *r,
1381                    struct dictionary *dict, struct variable **var_by_value_idx)
1382 {
1383   struct pool *subpool;
1384
1385   struct label
1386     {
1387       uint8_t raw_value[8];        /* Value as uninterpreted bytes. */
1388       union value value;        /* Value. */
1389       char *label;              /* Null-terminated label string. */
1390     };
1391
1392   struct label *labels = NULL;
1393   int label_cnt;                /* Number of labels. */
1394
1395   struct variable **var = NULL; /* Associated variables. */
1396   int var_cnt;                  /* Number of associated variables. */
1397   int max_width;                /* Maximum width of string variables. */
1398
1399   int i;
1400
1401   subpool = pool_create_subpool (r->pool);
1402
1403   /* Read the type 3 record and record its contents.  We can't do
1404      much with the data yet because we don't know whether it is
1405      of numeric or string type. */
1406
1407   /* Read number of labels. */
1408   label_cnt = read_int (r);
1409
1410   if (size_overflow_p (xtimes (label_cnt, sizeof *labels)))
1411     sys_error (r, _("Invalid number of labels %d."), label_cnt);
1412
1413   /* Read each value/label tuple into labels[]. */
1414   labels = pool_nalloc (subpool, label_cnt, sizeof *labels);
1415   for (i = 0; i < label_cnt; i++)
1416     {
1417       struct label *label = labels + i;
1418       unsigned char label_len;
1419       size_t padded_len;
1420
1421       /* Read value. */
1422       read_bytes (r, label->raw_value, sizeof label->raw_value);
1423
1424       /* Read label length. */
1425       read_bytes (r, &label_len, sizeof label_len);
1426       padded_len = ROUND_UP (label_len + 1, 8);
1427
1428       /* Read label, padding. */
1429       label->label = pool_alloc (subpool, padded_len + 1);
1430       read_bytes (r, label->label, padded_len - 1);
1431       label->label[label_len] = 0;
1432     }
1433
1434   /* Now, read the type 4 record that has the list of variables
1435      to which the value labels are to be applied. */
1436
1437   /* Read record type of type 4 record. */
1438   if (read_int (r) != 4)
1439     sys_error (r, _("Variable index record (type 4) does not immediately "
1440                     "follow value label record (type 3) as it should."));
1441
1442   /* Read number of variables associated with value label from type 4
1443      record. */
1444   var_cnt = read_int (r);
1445   if (var_cnt < 1 || var_cnt > dict_get_var_cnt (dict))
1446     sys_error (r, _("Number of variables associated with a value label (%d) "
1447                     "is not between 1 and the number of variables (%zu)."),
1448                var_cnt, dict_get_var_cnt (dict));
1449
1450   /* Read the list of variables. */
1451   var = pool_nalloc (subpool, var_cnt, sizeof *var);
1452   max_width = 0;
1453   for (i = 0; i < var_cnt; i++)
1454     {
1455       var[i] = lookup_var_by_value_idx (r, var_by_value_idx, read_int (r));
1456       if (var_get_width (var[i]) > 8)
1457         sys_error (r, _("Value labels may not be added to long string "
1458                         "variables (e.g. %s) using records types 3 and 4."),
1459                    var_get_name (var[i]));
1460       max_width = MAX (max_width, var_get_width (var[i]));
1461     }
1462
1463   /* Type check the variables. */
1464   for (i = 1; i < var_cnt; i++)
1465     if (var_get_type (var[i]) != var_get_type (var[0]))
1466       sys_error (r, _("Variables associated with value label are not all of "
1467                       "identical type.  Variable %s is %s, but variable "
1468                       "%s is %s."),
1469                  var_get_name (var[0]),
1470                  var_is_numeric (var[0]) ? _("numeric") : _("string"),
1471                  var_get_name (var[i]),
1472                  var_is_numeric (var[i]) ? _("numeric") : _("string"));
1473
1474   /* Fill in labels[].value, now that we know the desired type. */
1475   for (i = 0; i < label_cnt; i++)
1476     {
1477       struct label *label = labels + i;
1478
1479       value_init_pool (subpool, &label->value, max_width);
1480       if (var_is_alpha (var[0]))
1481         u8_buf_copy_rpad (value_str_rw (&label->value, max_width), max_width,
1482                        label->raw_value, sizeof label->raw_value, ' ');
1483       else
1484         label->value.f = float_get_double (r->float_format, label->raw_value);
1485     }
1486
1487   /* Assign the `value_label's to each variable. */
1488   for (i = 0; i < var_cnt; i++)
1489     {
1490       struct variable *v = var[i];
1491       int j;
1492
1493       /* Add each label to the variable. */
1494       for (j = 0; j < label_cnt; j++)
1495         {
1496           struct label *label = &labels[j];
1497           if (!var_add_value_label (v, &label->value, label->label))
1498             {
1499               if (var_is_numeric (var[0]))
1500                 sys_warn (r, _("Duplicate value label for %g on %s."),
1501                           label->value.f, var_get_name (v));
1502               else
1503                 sys_warn (r, _("Duplicate value label for `%.*s' on %s."),
1504                           max_width, value_str (&label->value, max_width),
1505                           var_get_name (v));
1506             }
1507         }
1508     }
1509
1510   pool_destroy (subpool);
1511 }
1512
1513 /* Reads a set of custom attributes from TEXT into ATTRS.
1514    ATTRS may be a null pointer, in which case the attributes are
1515    read but discarded. */
1516 static void
1517 read_attributes (struct sfm_reader *r, struct text_record *text,
1518                  struct attrset *attrs)
1519 {
1520   do
1521     {
1522       struct attribute *attr;
1523       char *key;
1524       int index;
1525
1526       /* Parse the key. */
1527       key = text_get_token (text, ss_cstr ("("), NULL);
1528       if (key == NULL)
1529         return;
1530
1531       attr = attribute_create (key);
1532       for (index = 1; ; index++)
1533         {
1534           /* Parse the value. */
1535           char *value;
1536           size_t length;
1537
1538           value = text_get_token (text, ss_cstr ("\n"), NULL);
1539           if (value == NULL)
1540             {
1541               text_warn (r, text, _("Error parsing attribute value %s[%d]."),
1542                          key, index);
1543               break;
1544             }              
1545
1546           length = strlen (value);
1547           if (length >= 2 && value[0] == '\'' && value[length - 1] == '\'') 
1548             {
1549               value[length - 1] = '\0';
1550               attribute_add_value (attr, value + 1); 
1551             }
1552           else 
1553             {
1554               text_warn (r, text,
1555                          _("Attribute value %s[%d] is not quoted: %s."),
1556                          key, index, value);
1557               attribute_add_value (attr, value); 
1558             }
1559
1560           /* Was this the last value for this attribute? */
1561           if (text_match (text, ')'))
1562             break;
1563         }
1564       if (attrs != NULL)
1565         attrset_add (attrs, attr);
1566       else
1567         attribute_destroy (attr);
1568     }
1569   while (!text_match (text, '/'));
1570 }
1571
1572 /* Reads record type 7, subtype 17, which lists custom
1573    attributes on the data file.  */
1574 static void
1575 read_data_file_attributes (struct sfm_reader *r,
1576                            size_t size, size_t count,
1577                            struct dictionary *dict)
1578 {
1579   struct text_record *text = open_text_record (r, size * count);
1580   read_attributes (r, text, dict_get_attributes (dict));
1581   close_text_record (r, text);
1582 }
1583
1584 static void
1585 skip_long_string_value_labels (struct sfm_reader *r, size_t n_labels)
1586 {
1587   size_t i;
1588
1589   for (i = 0; i < n_labels; i++)
1590     {
1591       size_t value_length, label_length;
1592
1593       value_length = read_int (r);
1594       skip_bytes (r, value_length);
1595       label_length = read_int (r);
1596       skip_bytes (r, label_length);
1597     }
1598 }
1599
1600 static void
1601 read_long_string_value_labels (struct sfm_reader *r,
1602                                size_t size, size_t count,
1603                                struct dictionary *d)
1604 {
1605   const off_t start = ftello (r->file);
1606   while (ftello (r->file) - start < size * count)
1607     {
1608       char var_name[VAR_NAME_LEN + 1];
1609       size_t n_labels, i;
1610       struct variable *v;
1611       union value value;
1612       int var_name_len;
1613       int width;
1614
1615       /* Read header. */
1616       var_name_len = read_int (r);
1617       if (var_name_len > VAR_NAME_LEN)
1618         sys_error (r, _("Variable name length in long string value label "
1619                         "record (%d) exceeds %d-byte limit."),
1620                    var_name_len, VAR_NAME_LEN);
1621       read_string (r, var_name, var_name_len + 1);
1622       width = read_int (r);
1623       n_labels = read_int (r);
1624
1625       v = dict_lookup_var (d, var_name);
1626       if (v == NULL)
1627         {
1628           sys_warn (r, _("Ignoring long string value record for "
1629                          "unknown variable %s."), var_name);
1630           skip_long_string_value_labels (r, n_labels);
1631           continue;
1632         }
1633       if (var_is_numeric (v))
1634         {
1635           sys_warn (r, _("Ignoring long string value record for "
1636                          "numeric variable %s."), var_name);
1637           skip_long_string_value_labels (r, n_labels);
1638           continue;
1639         }
1640       if (width != var_get_width (v))
1641         {
1642           sys_warn (r, _("Ignoring long string value record for variable %s "
1643                          "because the record's width (%d) does not match the "
1644                          "variable's width (%d)."),
1645                     var_name, width, var_get_width (v));
1646           skip_long_string_value_labels (r, n_labels);
1647           continue;
1648         }
1649
1650       /* Read values. */
1651       value_init_pool (r->pool, &value, width);
1652       for (i = 0; i < n_labels; i++)
1653         {
1654           size_t value_length, label_length;
1655           char label[256];
1656           bool skip = false;
1657
1658           /* Read value. */
1659           value_length = read_int (r);
1660           if (value_length == width)
1661             read_bytes (r, value_str_rw (&value, width), width);
1662           else
1663             {
1664               sys_warn (r, _("Ignoring long string value %zu for variable %s, "
1665                              "with width %d, that has bad value width %zu."),
1666                         i, var_get_name (v), width, value_length);
1667               skip_bytes (r, value_length);
1668               skip = true;
1669             }
1670
1671           /* Read label. */
1672           label_length = read_int (r);
1673           read_string (r, label, MIN (sizeof label, label_length + 1));
1674           if (label_length >= sizeof label)
1675             {
1676               /* Skip and silently ignore label text after the
1677                  first 255 bytes.  The maximum documented length
1678                  of a label is 120 bytes so this is more than
1679                  generous. */
1680               skip_bytes (r, (label_length + 1) - sizeof label);
1681             }
1682
1683           if (!skip && !var_add_value_label (v, &value, label))
1684             sys_warn (r, _("Duplicate value label for `%.*s' on %s."),
1685                       width, value_str (&value, width), var_get_name (v));
1686         }
1687     }
1688 }
1689
1690
1691 /* Reads record type 7, subtype 18, which lists custom
1692    attributes on individual variables.  */
1693 static void
1694 read_variable_attributes (struct sfm_reader *r,
1695                           size_t size, size_t count,
1696                           struct dictionary *dict)
1697 {
1698   struct text_record *text = open_text_record (r, size * count);
1699   for (;;) 
1700     {
1701       struct variable *var;
1702       if (!text_read_variable_name (r, dict, text, ss_cstr (":"), &var))
1703         break;
1704       read_attributes (r, text, var != NULL ? var_get_attributes (var) : NULL);
1705     }
1706   close_text_record (r, text);
1707 }
1708
1709 \f
1710 /* Case reader. */
1711
1712 static void partial_record (struct sfm_reader *r)
1713      NO_RETURN;
1714
1715 static void read_error (struct casereader *, const struct sfm_reader *);
1716
1717 static bool read_case_number (struct sfm_reader *, double *);
1718 static bool read_case_string (struct sfm_reader *, uint8_t *, size_t);
1719 static int read_opcode (struct sfm_reader *);
1720 static bool read_compressed_number (struct sfm_reader *, double *);
1721 static bool read_compressed_string (struct sfm_reader *, uint8_t *);
1722 static bool read_whole_strings (struct sfm_reader *, uint8_t *, size_t);
1723 static bool skip_whole_strings (struct sfm_reader *, size_t);
1724
1725 /* Reads and returns one case from READER's file.  Returns a null
1726    pointer if not successful. */
1727 static struct ccase *
1728 sys_file_casereader_read (struct casereader *reader, void *r_)
1729 {
1730   struct sfm_reader *r = r_;
1731   struct ccase *volatile c;
1732   int i;
1733
1734   if (r->error)
1735     return NULL;
1736
1737   c = case_create (r->proto);
1738   if (setjmp (r->bail_out))
1739     {
1740       casereader_force_error (reader);
1741       case_unref (c);
1742       return NULL;
1743     }
1744
1745   for (i = 0; i < r->sfm_var_cnt; i++)
1746     {
1747       struct sfm_var *sv = &r->sfm_vars[i];
1748       union value *v = case_data_rw_idx (c, sv->case_index);
1749
1750       if (sv->var_width == 0)
1751         {
1752           if (!read_case_number (r, &v->f))
1753             goto eof;
1754         }
1755       else
1756         {
1757           uint8_t *s = value_str_rw (v, sv->var_width);
1758           if (!read_case_string (r, s + sv->offset, sv->segment_width))
1759             goto eof;
1760           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
1761             partial_record (r);
1762         }
1763     }
1764   return c;
1765
1766 eof:
1767   if (i != 0)
1768     partial_record (r);
1769   if (r->case_cnt != -1)
1770     read_error (reader, r);
1771   case_unref (c);
1772   return NULL;
1773 }
1774
1775 /* Issues an error that R ends in a partial record. */
1776 static void
1777 partial_record (struct sfm_reader *r)
1778 {
1779   sys_error (r, _("File ends in partial case."));
1780 }
1781
1782 /* Issues an error that an unspecified error occurred SFM, and
1783    marks R tainted. */
1784 static void
1785 read_error (struct casereader *r, const struct sfm_reader *sfm)
1786 {
1787   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
1788   casereader_force_error (r);
1789 }
1790
1791 /* Reads a number from R and stores its value in *D.
1792    If R is compressed, reads a compressed number;
1793    otherwise, reads a number in the regular way.
1794    Returns true if successful, false if end of file is
1795    reached immediately. */
1796 static bool
1797 read_case_number (struct sfm_reader *r, double *d)
1798 {
1799   if (!r->compressed)
1800     {
1801       uint8_t number[8];
1802       if (!try_read_bytes (r, number, sizeof number))
1803         return false;
1804       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
1805       return true;
1806     }
1807   else
1808     return read_compressed_number (r, d);
1809 }
1810
1811 /* Reads LENGTH string bytes from R into S.
1812    Always reads a multiple of 8 bytes; if LENGTH is not a
1813    multiple of 8, then extra bytes are read and discarded without
1814    being written to S.
1815    Reads compressed strings if S is compressed.
1816    Returns true if successful, false if end of file is
1817    reached immediately. */
1818 static bool
1819 read_case_string (struct sfm_reader *r, uint8_t *s, size_t length)
1820 {
1821   size_t whole = ROUND_DOWN (length, 8);
1822   size_t partial = length % 8;
1823
1824   if (whole)
1825     {
1826       if (!read_whole_strings (r, s, whole))
1827         return false;
1828     }
1829
1830   if (partial)
1831     {
1832       uint8_t bounce[8];
1833       if (!read_whole_strings (r, bounce, sizeof bounce))
1834         {
1835           if (whole)
1836             partial_record (r);
1837           return false;
1838         }
1839       memcpy (s + whole, bounce, partial);
1840     }
1841
1842   return true;
1843 }
1844
1845 /* Reads and returns the next compression opcode from R. */
1846 static int
1847 read_opcode (struct sfm_reader *r)
1848 {
1849   assert (r->compressed);
1850   for (;;)
1851     {
1852       int opcode;
1853       if (r->opcode_idx >= sizeof r->opcodes)
1854         {
1855           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
1856             return -1;
1857           r->opcode_idx = 0;
1858         }
1859       opcode = r->opcodes[r->opcode_idx++];
1860
1861       if (opcode != 0)
1862         return opcode;
1863     }
1864 }
1865
1866 /* Reads a compressed number from R and stores its value in D.
1867    Returns true if successful, false if end of file is
1868    reached immediately. */
1869 static bool
1870 read_compressed_number (struct sfm_reader *r, double *d)
1871 {
1872   int opcode = read_opcode (r);
1873   switch (opcode)
1874     {
1875     case -1:
1876     case 252:
1877       return false;
1878
1879     case 253:
1880       *d = read_float (r);
1881       break;
1882
1883     case 254:
1884       float_convert (r->float_format, "        ", FLOAT_NATIVE_DOUBLE, d);
1885       if (!r->corruption_warning)
1886         {
1887           r->corruption_warning = true;
1888           sys_warn (r, _("Possible compressed data corruption: "
1889                          "compressed spaces appear in numeric field."));
1890         }
1891       break;
1892
1893     case 255:
1894       *d = SYSMIS;
1895       break;
1896
1897     default:
1898       *d = opcode - r->bias;
1899       break;
1900     }
1901
1902   return true;
1903 }
1904
1905 /* Reads a compressed 8-byte string segment from R and stores it
1906    in DST.
1907    Returns true if successful, false if end of file is
1908    reached immediately. */
1909 static bool
1910 read_compressed_string (struct sfm_reader *r, uint8_t *dst)
1911 {
1912   int opcode = read_opcode (r);
1913   switch (opcode)
1914     {
1915     case -1:
1916     case 252:
1917       return false;
1918
1919     case 253:
1920       read_bytes (r, dst, 8);
1921       break;
1922
1923     case 254:
1924       memset (dst, ' ', 8);
1925       break;
1926
1927     default:
1928       {
1929         double value = opcode - r->bias;
1930         float_convert (FLOAT_NATIVE_DOUBLE, &value, r->float_format, dst);
1931         if (value == 0.0)
1932           {
1933             /* This has actually been seen "in the wild".  The submitter of the
1934                file that showed that the contents decoded as spaces, but they
1935                were at the end of the field so it's possible that the null
1936                bytes just acted as null terminators. */
1937           }
1938         else if (!r->corruption_warning)
1939           {
1940             r->corruption_warning = true;
1941             sys_warn (r, _("Possible compressed data corruption: "
1942                            "string contains compressed integer (opcode %d)."),
1943                       opcode);
1944           }
1945       }
1946       break;
1947     }
1948
1949   return true;
1950 }
1951
1952 /* Reads LENGTH string bytes from R into S.
1953    LENGTH must be a multiple of 8.
1954    Reads compressed strings if S is compressed.
1955    Returns true if successful, false if end of file is
1956    reached immediately. */
1957 static bool
1958 read_whole_strings (struct sfm_reader *r, uint8_t *s, size_t length)
1959 {
1960   assert (length % 8 == 0);
1961   if (!r->compressed)
1962     return try_read_bytes (r, s, length);
1963   else
1964     {
1965       size_t ofs;
1966       for (ofs = 0; ofs < length; ofs += 8)
1967         if (!read_compressed_string (r, s + ofs))
1968           {
1969             if (ofs != 0)
1970               partial_record (r);
1971             return false;
1972           }
1973       return true;
1974     }
1975 }
1976
1977 /* Skips LENGTH string bytes from R.
1978    LENGTH must be a multiple of 8.
1979    (LENGTH is also limited to 1024, but that's only because the
1980    current caller never needs more than that many bytes.)
1981    Returns true if successful, false if end of file is
1982    reached immediately. */
1983 static bool
1984 skip_whole_strings (struct sfm_reader *r, size_t length)
1985 {
1986   uint8_t buffer[1024];
1987   assert (length < sizeof buffer);
1988   return read_whole_strings (r, buffer, length);
1989 }
1990 \f
1991 /* Creates and returns a table that can be used for translating a value
1992    index into a case to a "struct variable *" for DICT.  Multiple
1993    system file fields reference variables this way.
1994
1995    This table must be created before processing the very long
1996    string extension record, because that record causes some
1997    values to be deleted from the case and the dictionary to be
1998    compacted. */
1999 static struct variable **
2000 make_var_by_value_idx (struct sfm_reader *r, struct dictionary *dict)
2001 {
2002   struct variable **var_by_value_idx;
2003   int value_idx = 0;
2004   int i;
2005
2006   var_by_value_idx = pool_nmalloc (r->pool,
2007                                    r->oct_cnt, sizeof *var_by_value_idx);
2008   for (i = 0; i < dict_get_var_cnt (dict); i++)
2009     {
2010       struct variable *v = dict_get_var (dict, i);
2011       int nv = var_is_numeric (v) ? 1 : DIV_RND_UP (var_get_width (v), 8);
2012       int j;
2013
2014       var_by_value_idx[value_idx++] = v;
2015       for (j = 1; j < nv; j++)
2016         var_by_value_idx[value_idx++] = NULL;
2017     }
2018   assert (value_idx == r->oct_cnt);
2019
2020   return var_by_value_idx;
2021 }
2022
2023 /* Returns the "struct variable" corresponding to the given
2024    1-basd VALUE_IDX in VAR_BY_VALUE_IDX.  Verifies that the index
2025    is valid. */
2026 static struct variable *
2027 lookup_var_by_value_idx (struct sfm_reader *r,
2028                          struct variable **var_by_value_idx, int value_idx)
2029 {
2030   struct variable *var;
2031
2032   if (value_idx < 1 || value_idx > r->oct_cnt)
2033     sys_error (r, _("Variable index %d not in valid range 1...%d."),
2034                value_idx, r->oct_cnt);
2035
2036   var = var_by_value_idx[value_idx - 1];
2037   if (var == NULL)
2038     sys_error (r, _("Variable index %d refers to long string "
2039                     "continuation."),
2040                value_idx);
2041
2042   return var;
2043 }
2044
2045 /* Returns the variable in D with the given SHORT_NAME,
2046    or a null pointer if there is none. */
2047 static struct variable *
2048 lookup_var_by_short_name (struct dictionary *d, const char *short_name)
2049 {
2050   struct variable *var;
2051   size_t var_cnt;
2052   size_t i;
2053
2054   /* First try looking up by full name.  This often succeeds. */
2055   var = dict_lookup_var (d, short_name);
2056   if (var != NULL && !strcasecmp (var_get_short_name (var, 0), short_name))
2057     return var;
2058
2059   /* Iterate through the whole dictionary as a fallback. */
2060   var_cnt = dict_get_var_cnt (d);
2061   for (i = 0; i < var_cnt; i++)
2062     {
2063       var = dict_get_var (d, i);
2064       if (!strcasecmp (var_get_short_name (var, 0), short_name))
2065         return var;
2066     }
2067
2068   return NULL;
2069 }
2070 \f
2071 /* Helpers for reading records that contain structured text
2072    strings. */
2073
2074 /* Maximum number of warnings to issue for a single text
2075    record. */
2076 #define MAX_TEXT_WARNINGS 5
2077
2078 /* State. */
2079 struct text_record
2080   {
2081     struct substring buffer;    /* Record contents. */
2082     size_t pos;                 /* Current position in buffer. */
2083     int n_warnings;             /* Number of warnings issued or suppressed. */
2084   };
2085
2086 /* Reads SIZE bytes into a text record for R,
2087    and returns the new text record. */
2088 static struct text_record *
2089 open_text_record (struct sfm_reader *r, size_t size)
2090 {
2091   struct text_record *text = pool_alloc (r->pool, sizeof *text);
2092   char *buffer = pool_malloc (r->pool, size + 1);
2093   read_bytes (r, buffer, size);
2094   text->buffer = ss_buffer (buffer, size);
2095   text->pos = 0;
2096   text->n_warnings = 0;
2097   return text;
2098 }
2099
2100 /* Closes TEXT, frees its storage, and issues a final warning
2101    about suppressed warnings if necesary. */
2102 static void
2103 close_text_record (struct sfm_reader *r, struct text_record *text)
2104 {
2105   if (text->n_warnings > MAX_TEXT_WARNINGS)
2106     sys_warn (r, _("Suppressed %d additional related warnings."),
2107               text->n_warnings - MAX_TEXT_WARNINGS);
2108   pool_free (r->pool, ss_data (text->buffer));
2109 }
2110
2111 /* Reads a variable=value pair from TEXT.
2112    Looks up the variable in DICT and stores it into *VAR.
2113    Stores a null-terminated value into *VALUE. */
2114 static bool
2115 read_variable_to_value_pair (struct sfm_reader *r, struct dictionary *dict,
2116                              struct text_record *text,
2117                              struct variable **var, char **value)
2118 {
2119   for (;;)
2120     {
2121       if (!text_read_short_name (r, dict, text, ss_cstr ("="), var))
2122         return false;
2123       
2124       *value = text_get_token (text, ss_buffer ("\t\0", 2), NULL);
2125       if (*value == NULL)
2126         return false;
2127
2128       text->pos += ss_span (ss_substr (text->buffer, text->pos, SIZE_MAX),
2129                             ss_buffer ("\t\0", 2));
2130
2131       if (*var != NULL)
2132         return true;
2133     }
2134 }
2135
2136 static bool
2137 text_read_variable_name (struct sfm_reader *r, struct dictionary *dict,
2138                          struct text_record *text, struct substring delimiters,
2139                          struct variable **var)
2140 {
2141   char *name;
2142
2143   name = text_get_token (text, delimiters, NULL);
2144   if (name == NULL)
2145     return false;
2146
2147   *var = dict_lookup_var (dict, name);
2148   if (*var != NULL)
2149     return true;
2150
2151   text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2152              name);
2153   return false;
2154 }
2155
2156
2157 static bool
2158 text_read_short_name (struct sfm_reader *r, struct dictionary *dict,
2159                       struct text_record *text, struct substring delimiters,
2160                       struct variable **var)
2161 {
2162   char *short_name = text_get_token (text, delimiters, NULL);
2163   if (short_name == NULL)
2164     return false;
2165
2166   *var = lookup_var_by_short_name (dict, short_name);
2167   if (*var == NULL)
2168     text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2169                short_name);
2170   return true;
2171 }
2172
2173 /* Displays a warning for the current file position, limiting the
2174    number to MAX_TEXT_WARNINGS for TEXT. */
2175 static void
2176 text_warn (struct sfm_reader *r, struct text_record *text,
2177            const char *format, ...)
2178 {
2179   if (text->n_warnings++ < MAX_TEXT_WARNINGS) 
2180     {
2181       va_list args;
2182
2183       va_start (args, format);
2184       sys_msg (r, MW, format, args);
2185       va_end (args);
2186     }
2187 }
2188
2189 static char *
2190 text_get_token (struct text_record *text, struct substring delimiters,
2191                 char *delimiter)
2192 {
2193   struct substring token;
2194   char *end;
2195
2196   if (!ss_tokenize (text->buffer, delimiters, &text->pos, &token))
2197     return NULL;
2198
2199   end = &ss_data (token)[ss_length (token)];
2200   if (delimiter != NULL)
2201     *delimiter = *end;
2202   *end = '\0';
2203   return ss_data (token);
2204 }
2205
2206 /* Reads a integer value expressed in decimal, then a space, then a string that
2207    consists of exactly as many bytes as specified by the integer, then a space,
2208    from TEXT.  Returns the string, null-terminated, as a subset of TEXT's
2209    buffer (so the caller should not free the string). */
2210 static const char *
2211 text_parse_counted_string (struct sfm_reader *r, struct text_record *text)
2212 {
2213   size_t start;
2214   size_t n;
2215   char *s;
2216
2217   start = text->pos;
2218   n = 0;
2219   for (;;)
2220     {
2221       int c = text->buffer.string[text->pos];
2222       if (c < '0' || c > '9')
2223         break;
2224       n = (n * 10) + (c - '0');
2225       text->pos++;
2226     }
2227   if (start == text->pos)
2228     {
2229       sys_warn (r, _("Expecting digit at offset %zu in MRSETS record."),
2230                  text->pos);
2231       return NULL;
2232     }
2233
2234   if (!text_match (text, ' '))
2235     {
2236       sys_warn (r, _("Expecting space at offset %zu in MRSETS record."),
2237                 text->pos);
2238       return NULL;
2239     }
2240
2241   if (text->pos + n > text->buffer.length)
2242     {
2243       sys_warn (r, _("%zu-byte string starting at offset %zu "
2244                      "exceeds record length %zu."),
2245                 n, text->pos, text->buffer.length);
2246       return NULL;
2247     }
2248
2249   s = &text->buffer.string[text->pos];
2250   if (s[n] != ' ')
2251     {
2252       sys_warn (r,
2253                 _("Expecting space at offset %zu following %zu-byte string."),
2254                 text->pos + n, n);
2255       return NULL;
2256     }
2257   s[n] = '\0';
2258   text->pos += n + 1;
2259   return s;
2260 }
2261
2262 static bool
2263 text_match (struct text_record *text, char c)
2264 {
2265   if (text->buffer.string[text->pos] == c) 
2266     {
2267       text->pos++;
2268       return true;
2269     }
2270   else
2271     return false;
2272 }
2273
2274 /* Returns the current byte offset inside the TEXT's string. */
2275 static size_t
2276 text_pos (const struct text_record *text)
2277 {
2278   return text->pos;
2279 }
2280 \f
2281 /* Messages. */
2282
2283 /* Displays a corruption message. */
2284 static void
2285 sys_msg (struct sfm_reader *r, int class, const char *format, va_list args)
2286 {
2287   struct msg m;
2288   struct string text;
2289
2290   ds_init_empty (&text);
2291   ds_put_format (&text, "`%s' near offset 0x%llx: ",
2292                  fh_get_file_name (r->fh), (long long int) ftello (r->file));
2293   ds_put_vformat (&text, format, args);
2294
2295   m.category = msg_class_to_category (class);
2296   m.severity = msg_class_to_severity (class);
2297   m.where.file_name = NULL;
2298   m.where.line_number = 0;
2299   m.where.first_column = 0;
2300   m.where.last_column = 0;
2301   m.text = ds_cstr (&text);
2302
2303   msg_emit (&m);
2304 }
2305
2306 /* Displays a warning for the current file position. */
2307 static void
2308 sys_warn (struct sfm_reader *r, const char *format, ...)
2309 {
2310   va_list args;
2311
2312   va_start (args, format);
2313   sys_msg (r, MW, format, args);
2314   va_end (args);
2315 }
2316
2317 /* Displays an error for the current file position,
2318    marks it as in an error state,
2319    and aborts reading it using longjmp. */
2320 static void
2321 sys_error (struct sfm_reader *r, const char *format, ...)
2322 {
2323   va_list args;
2324
2325   va_start (args, format);
2326   sys_msg (r, ME, format, args);
2327   va_end (args);
2328
2329   r->error = true;
2330   longjmp (r->bail_out, 1);
2331 }
2332 \f
2333 /* Reads BYTE_CNT bytes into BUF.
2334    Returns true if exactly BYTE_CNT bytes are successfully read.
2335    Aborts if an I/O error or a partial read occurs.
2336    If EOF_IS_OK, then an immediate end-of-file causes false to be
2337    returned; otherwise, immediate end-of-file causes an abort
2338    too. */
2339 static inline bool
2340 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
2341                    void *buf, size_t byte_cnt)
2342 {
2343   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
2344   if (bytes_read == byte_cnt)
2345     return true;
2346   else if (ferror (r->file))
2347     sys_error (r, _("System error: %s."), strerror (errno));
2348   else if (!eof_is_ok || bytes_read != 0)
2349     sys_error (r, _("Unexpected end of file."));
2350   else
2351     return false;
2352 }
2353
2354 /* Reads BYTE_CNT into BUF.
2355    Aborts upon I/O error or if end-of-file is encountered. */
2356 static void
2357 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2358 {
2359   read_bytes_internal (r, false, buf, byte_cnt);
2360 }
2361
2362 /* Reads BYTE_CNT bytes into BUF.
2363    Returns true if exactly BYTE_CNT bytes are successfully read.
2364    Returns false if an immediate end-of-file is encountered.
2365    Aborts if an I/O error or a partial read occurs. */
2366 static bool
2367 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2368 {
2369   return read_bytes_internal (r, true, buf, byte_cnt);
2370 }
2371
2372 /* Reads a 32-bit signed integer from R and returns its value in
2373    host format. */
2374 static int
2375 read_int (struct sfm_reader *r)
2376 {
2377   uint8_t integer[4];
2378   read_bytes (r, integer, sizeof integer);
2379   return integer_get (r->integer_format, integer, sizeof integer);
2380 }
2381
2382 /* Reads a 64-bit floating-point number from R and returns its
2383    value in host format. */
2384 static double
2385 read_float (struct sfm_reader *r)
2386 {
2387   uint8_t number[8];
2388   read_bytes (r, number, sizeof number);
2389   return float_get_double (r->float_format, number);
2390 }
2391
2392 /* Reads exactly SIZE - 1 bytes into BUFFER
2393    and stores a null byte into BUFFER[SIZE - 1]. */
2394 static void
2395 read_string (struct sfm_reader *r, char *buffer, size_t size)
2396 {
2397   assert (size > 0);
2398   read_bytes (r, buffer, size - 1);
2399   buffer[size - 1] = '\0';
2400 }
2401
2402 /* Skips BYTES bytes forward in R. */
2403 static void
2404 skip_bytes (struct sfm_reader *r, size_t bytes)
2405 {
2406   while (bytes > 0)
2407     {
2408       char buffer[1024];
2409       size_t chunk = MIN (sizeof buffer, bytes);
2410       read_bytes (r, buffer, chunk);
2411       bytes -= chunk;
2412     }
2413 }
2414 \f
2415 static const struct casereader_class sys_file_casereader_class =
2416   {
2417     sys_file_casereader_read,
2418     sys_file_casereader_destroy,
2419     NULL,
2420     NULL,
2421   };