sys-file-reader: Avoid redundant "within system file" in messages.
[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     {
1412       sys_warn (r, _("Invalid number of labels: %d.  Ignoring labels."),
1413                 label_cnt);
1414       label_cnt = 0;
1415     }
1416
1417   /* Read each value/label tuple into labels[]. */
1418   labels = pool_nalloc (subpool, label_cnt, sizeof *labels);
1419   for (i = 0; i < label_cnt; i++)
1420     {
1421       struct label *label = labels + i;
1422       unsigned char label_len;
1423       size_t padded_len;
1424
1425       /* Read value. */
1426       read_bytes (r, label->raw_value, sizeof label->raw_value);
1427
1428       /* Read label length. */
1429       read_bytes (r, &label_len, sizeof label_len);
1430       padded_len = ROUND_UP (label_len + 1, 8);
1431
1432       /* Read label, padding. */
1433       label->label = pool_alloc (subpool, padded_len + 1);
1434       read_bytes (r, label->label, padded_len - 1);
1435       label->label[label_len] = 0;
1436     }
1437
1438   /* Now, read the type 4 record that has the list of variables
1439      to which the value labels are to be applied. */
1440
1441   /* Read record type of type 4 record. */
1442   if (read_int (r) != 4)
1443     sys_error (r, _("Variable index record (type 4) does not immediately "
1444                     "follow value label record (type 3) as it should."));
1445
1446   /* Read number of variables associated with value label from type 4
1447      record. */
1448   var_cnt = read_int (r);
1449   if (var_cnt < 1 || var_cnt > dict_get_var_cnt (dict))
1450     sys_error (r, _("Number of variables associated with a value label (%d) "
1451                     "is not between 1 and the number of variables (%zu)."),
1452                var_cnt, dict_get_var_cnt (dict));
1453
1454   /* Read the list of variables. */
1455   var = pool_nalloc (subpool, var_cnt, sizeof *var);
1456   max_width = 0;
1457   for (i = 0; i < var_cnt; i++)
1458     {
1459       var[i] = lookup_var_by_value_idx (r, var_by_value_idx, read_int (r));
1460       if (var_get_width (var[i]) > 8)
1461         sys_error (r, _("Value labels may not be added to long string "
1462                         "variables (e.g. %s) using records types 3 and 4."),
1463                    var_get_name (var[i]));
1464       max_width = MAX (max_width, var_get_width (var[i]));
1465     }
1466
1467   /* Type check the variables. */
1468   for (i = 1; i < var_cnt; i++)
1469     if (var_get_type (var[i]) != var_get_type (var[0]))
1470       sys_error (r, _("Variables associated with value label are not all of "
1471                       "identical type.  Variable %s is %s, but variable "
1472                       "%s is %s."),
1473                  var_get_name (var[0]),
1474                  var_is_numeric (var[0]) ? _("numeric") : _("string"),
1475                  var_get_name (var[i]),
1476                  var_is_numeric (var[i]) ? _("numeric") : _("string"));
1477
1478   /* Fill in labels[].value, now that we know the desired type. */
1479   for (i = 0; i < label_cnt; i++)
1480     {
1481       struct label *label = labels + i;
1482
1483       value_init_pool (subpool, &label->value, max_width);
1484       if (var_is_alpha (var[0]))
1485         u8_buf_copy_rpad (value_str_rw (&label->value, max_width), max_width,
1486                        label->raw_value, sizeof label->raw_value, ' ');
1487       else
1488         label->value.f = float_get_double (r->float_format, label->raw_value);
1489     }
1490
1491   /* Assign the `value_label's to each variable. */
1492   for (i = 0; i < var_cnt; i++)
1493     {
1494       struct variable *v = var[i];
1495       int j;
1496
1497       /* Add each label to the variable. */
1498       for (j = 0; j < label_cnt; j++)
1499         {
1500           struct label *label = &labels[j];
1501           if (!var_add_value_label (v, &label->value, label->label))
1502             {
1503               if (var_is_numeric (var[0]))
1504                 sys_warn (r, _("Duplicate value label for %g on %s."),
1505                           label->value.f, var_get_name (v));
1506               else
1507                 sys_warn (r, _("Duplicate value label for `%.*s' on %s."),
1508                           max_width, value_str (&label->value, max_width),
1509                           var_get_name (v));
1510             }
1511         }
1512     }
1513
1514   pool_destroy (subpool);
1515 }
1516
1517 /* Reads a set of custom attributes from TEXT into ATTRS.
1518    ATTRS may be a null pointer, in which case the attributes are
1519    read but discarded. */
1520 static void
1521 read_attributes (struct sfm_reader *r, struct text_record *text,
1522                  struct attrset *attrs)
1523 {
1524   do
1525     {
1526       struct attribute *attr;
1527       char *key;
1528       int index;
1529
1530       /* Parse the key. */
1531       key = text_get_token (text, ss_cstr ("("), NULL);
1532       if (key == NULL)
1533         return;
1534
1535       attr = attribute_create (key);
1536       for (index = 1; ; index++)
1537         {
1538           /* Parse the value. */
1539           char *value;
1540           size_t length;
1541
1542           value = text_get_token (text, ss_cstr ("\n"), NULL);
1543           if (value == NULL)
1544             {
1545               text_warn (r, text, _("Error parsing attribute value %s[%d]."),
1546                          key, index);
1547               break;
1548             }              
1549
1550           length = strlen (value);
1551           if (length >= 2 && value[0] == '\'' && value[length - 1] == '\'') 
1552             {
1553               value[length - 1] = '\0';
1554               attribute_add_value (attr, value + 1); 
1555             }
1556           else 
1557             {
1558               text_warn (r, text,
1559                          _("Attribute value %s[%d] is not quoted: %s."),
1560                          key, index, value);
1561               attribute_add_value (attr, value); 
1562             }
1563
1564           /* Was this the last value for this attribute? */
1565           if (text_match (text, ')'))
1566             break;
1567         }
1568       if (attrs != NULL)
1569         attrset_add (attrs, attr);
1570       else
1571         attribute_destroy (attr);
1572     }
1573   while (!text_match (text, '/'));
1574 }
1575
1576 /* Reads record type 7, subtype 17, which lists custom
1577    attributes on the data file.  */
1578 static void
1579 read_data_file_attributes (struct sfm_reader *r,
1580                            size_t size, size_t count,
1581                            struct dictionary *dict)
1582 {
1583   struct text_record *text = open_text_record (r, size * count);
1584   read_attributes (r, text, dict_get_attributes (dict));
1585   close_text_record (r, text);
1586 }
1587
1588 static void
1589 skip_long_string_value_labels (struct sfm_reader *r, size_t n_labels)
1590 {
1591   size_t i;
1592
1593   for (i = 0; i < n_labels; i++)
1594     {
1595       size_t value_length, label_length;
1596
1597       value_length = read_int (r);
1598       skip_bytes (r, value_length);
1599       label_length = read_int (r);
1600       skip_bytes (r, label_length);
1601     }
1602 }
1603
1604 static void
1605 read_long_string_value_labels (struct sfm_reader *r,
1606                                size_t size, size_t count,
1607                                struct dictionary *d)
1608 {
1609   const off_t start = ftello (r->file);
1610   while (ftello (r->file) - start < size * count)
1611     {
1612       char var_name[VAR_NAME_LEN + 1];
1613       size_t n_labels, i;
1614       struct variable *v;
1615       union value value;
1616       int var_name_len;
1617       int width;
1618
1619       /* Read header. */
1620       var_name_len = read_int (r);
1621       if (var_name_len > VAR_NAME_LEN)
1622         sys_error (r, _("Variable name length in long string value label "
1623                         "record (%d) exceeds %d-byte limit."),
1624                    var_name_len, VAR_NAME_LEN);
1625       read_string (r, var_name, var_name_len + 1);
1626       width = read_int (r);
1627       n_labels = read_int (r);
1628
1629       v = dict_lookup_var (d, var_name);
1630       if (v == NULL)
1631         {
1632           sys_warn (r, _("Ignoring long string value record for "
1633                          "unknown variable %s."), var_name);
1634           skip_long_string_value_labels (r, n_labels);
1635           continue;
1636         }
1637       if (var_is_numeric (v))
1638         {
1639           sys_warn (r, _("Ignoring long string value record for "
1640                          "numeric variable %s."), var_name);
1641           skip_long_string_value_labels (r, n_labels);
1642           continue;
1643         }
1644       if (width != var_get_width (v))
1645         {
1646           sys_warn (r, _("Ignoring long string value record for variable %s "
1647                          "because the record's width (%d) does not match the "
1648                          "variable's width (%d)."),
1649                     var_name, width, var_get_width (v));
1650           skip_long_string_value_labels (r, n_labels);
1651           continue;
1652         }
1653
1654       /* Read values. */
1655       value_init_pool (r->pool, &value, width);
1656       for (i = 0; i < n_labels; i++)
1657         {
1658           size_t value_length, label_length;
1659           char label[256];
1660           bool skip = false;
1661
1662           /* Read value. */
1663           value_length = read_int (r);
1664           if (value_length == width)
1665             read_bytes (r, value_str_rw (&value, width), width);
1666           else
1667             {
1668               sys_warn (r, _("Ignoring long string value %zu for variable %s, "
1669                              "with width %d, that has bad value width %zu."),
1670                         i, var_get_name (v), width, value_length);
1671               skip_bytes (r, value_length);
1672               skip = true;
1673             }
1674
1675           /* Read label. */
1676           label_length = read_int (r);
1677           read_string (r, label, MIN (sizeof label, label_length + 1));
1678           if (label_length >= sizeof label)
1679             {
1680               /* Skip and silently ignore label text after the
1681                  first 255 bytes.  The maximum documented length
1682                  of a label is 120 bytes so this is more than
1683                  generous. */
1684               skip_bytes (r, (label_length + 1) - sizeof label);
1685             }
1686
1687           if (!skip && !var_add_value_label (v, &value, label))
1688             sys_warn (r, _("Duplicate value label for `%.*s' on %s."),
1689                       width, value_str (&value, width), var_get_name (v));
1690         }
1691     }
1692 }
1693
1694
1695 /* Reads record type 7, subtype 18, which lists custom
1696    attributes on individual variables.  */
1697 static void
1698 read_variable_attributes (struct sfm_reader *r,
1699                           size_t size, size_t count,
1700                           struct dictionary *dict)
1701 {
1702   struct text_record *text = open_text_record (r, size * count);
1703   for (;;) 
1704     {
1705       struct variable *var;
1706       if (!text_read_variable_name (r, dict, text, ss_cstr (":"), &var))
1707         break;
1708       read_attributes (r, text, var != NULL ? var_get_attributes (var) : NULL);
1709     }
1710   close_text_record (r, text);
1711 }
1712
1713 \f
1714 /* Case reader. */
1715
1716 static void partial_record (struct sfm_reader *r)
1717      NO_RETURN;
1718
1719 static void read_error (struct casereader *, const struct sfm_reader *);
1720
1721 static bool read_case_number (struct sfm_reader *, double *);
1722 static bool read_case_string (struct sfm_reader *, uint8_t *, size_t);
1723 static int read_opcode (struct sfm_reader *);
1724 static bool read_compressed_number (struct sfm_reader *, double *);
1725 static bool read_compressed_string (struct sfm_reader *, uint8_t *);
1726 static bool read_whole_strings (struct sfm_reader *, uint8_t *, size_t);
1727 static bool skip_whole_strings (struct sfm_reader *, size_t);
1728
1729 /* Reads and returns one case from READER's file.  Returns a null
1730    pointer if not successful. */
1731 static struct ccase *
1732 sys_file_casereader_read (struct casereader *reader, void *r_)
1733 {
1734   struct sfm_reader *r = r_;
1735   struct ccase *volatile c;
1736   int i;
1737
1738   if (r->error)
1739     return NULL;
1740
1741   c = case_create (r->proto);
1742   if (setjmp (r->bail_out))
1743     {
1744       casereader_force_error (reader);
1745       case_unref (c);
1746       return NULL;
1747     }
1748
1749   for (i = 0; i < r->sfm_var_cnt; i++)
1750     {
1751       struct sfm_var *sv = &r->sfm_vars[i];
1752       union value *v = case_data_rw_idx (c, sv->case_index);
1753
1754       if (sv->var_width == 0)
1755         {
1756           if (!read_case_number (r, &v->f))
1757             goto eof;
1758         }
1759       else
1760         {
1761           uint8_t *s = value_str_rw (v, sv->var_width);
1762           if (!read_case_string (r, s + sv->offset, sv->segment_width))
1763             goto eof;
1764           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
1765             partial_record (r);
1766         }
1767     }
1768   return c;
1769
1770 eof:
1771   if (i != 0)
1772     partial_record (r);
1773   if (r->case_cnt != -1)
1774     read_error (reader, r);
1775   case_unref (c);
1776   return NULL;
1777 }
1778
1779 /* Issues an error that R ends in a partial record. */
1780 static void
1781 partial_record (struct sfm_reader *r)
1782 {
1783   sys_error (r, _("File ends in partial case."));
1784 }
1785
1786 /* Issues an error that an unspecified error occurred SFM, and
1787    marks R tainted. */
1788 static void
1789 read_error (struct casereader *r, const struct sfm_reader *sfm)
1790 {
1791   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
1792   casereader_force_error (r);
1793 }
1794
1795 /* Reads a number from R and stores its value in *D.
1796    If R is compressed, reads a compressed number;
1797    otherwise, reads a number in the regular way.
1798    Returns true if successful, false if end of file is
1799    reached immediately. */
1800 static bool
1801 read_case_number (struct sfm_reader *r, double *d)
1802 {
1803   if (!r->compressed)
1804     {
1805       uint8_t number[8];
1806       if (!try_read_bytes (r, number, sizeof number))
1807         return false;
1808       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
1809       return true;
1810     }
1811   else
1812     return read_compressed_number (r, d);
1813 }
1814
1815 /* Reads LENGTH string bytes from R into S.
1816    Always reads a multiple of 8 bytes; if LENGTH is not a
1817    multiple of 8, then extra bytes are read and discarded without
1818    being written to S.
1819    Reads compressed strings if S is compressed.
1820    Returns true if successful, false if end of file is
1821    reached immediately. */
1822 static bool
1823 read_case_string (struct sfm_reader *r, uint8_t *s, size_t length)
1824 {
1825   size_t whole = ROUND_DOWN (length, 8);
1826   size_t partial = length % 8;
1827
1828   if (whole)
1829     {
1830       if (!read_whole_strings (r, s, whole))
1831         return false;
1832     }
1833
1834   if (partial)
1835     {
1836       uint8_t bounce[8];
1837       if (!read_whole_strings (r, bounce, sizeof bounce))
1838         {
1839           if (whole)
1840             partial_record (r);
1841           return false;
1842         }
1843       memcpy (s + whole, bounce, partial);
1844     }
1845
1846   return true;
1847 }
1848
1849 /* Reads and returns the next compression opcode from R. */
1850 static int
1851 read_opcode (struct sfm_reader *r)
1852 {
1853   assert (r->compressed);
1854   for (;;)
1855     {
1856       int opcode;
1857       if (r->opcode_idx >= sizeof r->opcodes)
1858         {
1859           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
1860             return -1;
1861           r->opcode_idx = 0;
1862         }
1863       opcode = r->opcodes[r->opcode_idx++];
1864
1865       if (opcode != 0)
1866         return opcode;
1867     }
1868 }
1869
1870 /* Reads a compressed number from R and stores its value in D.
1871    Returns true if successful, false if end of file is
1872    reached immediately. */
1873 static bool
1874 read_compressed_number (struct sfm_reader *r, double *d)
1875 {
1876   int opcode = read_opcode (r);
1877   switch (opcode)
1878     {
1879     case -1:
1880     case 252:
1881       return false;
1882
1883     case 253:
1884       *d = read_float (r);
1885       break;
1886
1887     case 254:
1888       float_convert (r->float_format, "        ", FLOAT_NATIVE_DOUBLE, d);
1889       if (!r->corruption_warning)
1890         {
1891           r->corruption_warning = true;
1892           sys_warn (r, _("Possible compressed data corruption: "
1893                          "compressed spaces appear in numeric field."));
1894         }
1895       break;
1896
1897     case 255:
1898       *d = SYSMIS;
1899       break;
1900
1901     default:
1902       *d = opcode - r->bias;
1903       break;
1904     }
1905
1906   return true;
1907 }
1908
1909 /* Reads a compressed 8-byte string segment from R and stores it
1910    in DST.
1911    Returns true if successful, false if end of file is
1912    reached immediately. */
1913 static bool
1914 read_compressed_string (struct sfm_reader *r, uint8_t *dst)
1915 {
1916   int opcode = read_opcode (r);
1917   switch (opcode)
1918     {
1919     case -1:
1920     case 252:
1921       return false;
1922
1923     case 253:
1924       read_bytes (r, dst, 8);
1925       break;
1926
1927     case 254:
1928       memset (dst, ' ', 8);
1929       break;
1930
1931     default:
1932       {
1933         double value = opcode - r->bias;
1934         float_convert (FLOAT_NATIVE_DOUBLE, &value, r->float_format, dst);
1935         if (value == 0.0)
1936           {
1937             /* This has actually been seen "in the wild".  The submitter of the
1938                file that showed that the contents decoded as spaces, but they
1939                were at the end of the field so it's possible that the null
1940                bytes just acted as null terminators. */
1941           }
1942         else if (!r->corruption_warning)
1943           {
1944             r->corruption_warning = true;
1945             sys_warn (r, _("Possible compressed data corruption: "
1946                            "string contains compressed integer (opcode %d)."),
1947                       opcode);
1948           }
1949       }
1950       break;
1951     }
1952
1953   return true;
1954 }
1955
1956 /* Reads LENGTH string bytes from R into S.
1957    LENGTH must be a multiple of 8.
1958    Reads compressed strings if S is compressed.
1959    Returns true if successful, false if end of file is
1960    reached immediately. */
1961 static bool
1962 read_whole_strings (struct sfm_reader *r, uint8_t *s, size_t length)
1963 {
1964   assert (length % 8 == 0);
1965   if (!r->compressed)
1966     return try_read_bytes (r, s, length);
1967   else
1968     {
1969       size_t ofs;
1970       for (ofs = 0; ofs < length; ofs += 8)
1971         if (!read_compressed_string (r, s + ofs))
1972           {
1973             if (ofs != 0)
1974               partial_record (r);
1975             return false;
1976           }
1977       return true;
1978     }
1979 }
1980
1981 /* Skips LENGTH string bytes from R.
1982    LENGTH must be a multiple of 8.
1983    (LENGTH is also limited to 1024, but that's only because the
1984    current caller never needs more than that many bytes.)
1985    Returns true if successful, false if end of file is
1986    reached immediately. */
1987 static bool
1988 skip_whole_strings (struct sfm_reader *r, size_t length)
1989 {
1990   uint8_t buffer[1024];
1991   assert (length < sizeof buffer);
1992   return read_whole_strings (r, buffer, length);
1993 }
1994 \f
1995 /* Creates and returns a table that can be used for translating a value
1996    index into a case to a "struct variable *" for DICT.  Multiple
1997    system file fields reference variables this way.
1998
1999    This table must be created before processing the very long
2000    string extension record, because that record causes some
2001    values to be deleted from the case and the dictionary to be
2002    compacted. */
2003 static struct variable **
2004 make_var_by_value_idx (struct sfm_reader *r, struct dictionary *dict)
2005 {
2006   struct variable **var_by_value_idx;
2007   int value_idx = 0;
2008   int i;
2009
2010   var_by_value_idx = pool_nmalloc (r->pool,
2011                                    r->oct_cnt, sizeof *var_by_value_idx);
2012   for (i = 0; i < dict_get_var_cnt (dict); i++)
2013     {
2014       struct variable *v = dict_get_var (dict, i);
2015       int nv = var_is_numeric (v) ? 1 : DIV_RND_UP (var_get_width (v), 8);
2016       int j;
2017
2018       var_by_value_idx[value_idx++] = v;
2019       for (j = 1; j < nv; j++)
2020         var_by_value_idx[value_idx++] = NULL;
2021     }
2022   assert (value_idx == r->oct_cnt);
2023
2024   return var_by_value_idx;
2025 }
2026
2027 /* Returns the "struct variable" corresponding to the given
2028    1-basd VALUE_IDX in VAR_BY_VALUE_IDX.  Verifies that the index
2029    is valid. */
2030 static struct variable *
2031 lookup_var_by_value_idx (struct sfm_reader *r,
2032                          struct variable **var_by_value_idx, int value_idx)
2033 {
2034   struct variable *var;
2035
2036   if (value_idx < 1 || value_idx > r->oct_cnt)
2037     sys_error (r, _("Variable index %d not in valid range 1...%d."),
2038                value_idx, r->oct_cnt);
2039
2040   var = var_by_value_idx[value_idx - 1];
2041   if (var == NULL)
2042     sys_error (r, _("Variable index %d refers to long string "
2043                     "continuation."),
2044                value_idx);
2045
2046   return var;
2047 }
2048
2049 /* Returns the variable in D with the given SHORT_NAME,
2050    or a null pointer if there is none. */
2051 static struct variable *
2052 lookup_var_by_short_name (struct dictionary *d, const char *short_name)
2053 {
2054   struct variable *var;
2055   size_t var_cnt;
2056   size_t i;
2057
2058   /* First try looking up by full name.  This often succeeds. */
2059   var = dict_lookup_var (d, short_name);
2060   if (var != NULL && !strcasecmp (var_get_short_name (var, 0), short_name))
2061     return var;
2062
2063   /* Iterate through the whole dictionary as a fallback. */
2064   var_cnt = dict_get_var_cnt (d);
2065   for (i = 0; i < var_cnt; i++)
2066     {
2067       var = dict_get_var (d, i);
2068       if (!strcasecmp (var_get_short_name (var, 0), short_name))
2069         return var;
2070     }
2071
2072   return NULL;
2073 }
2074 \f
2075 /* Helpers for reading records that contain structured text
2076    strings. */
2077
2078 /* Maximum number of warnings to issue for a single text
2079    record. */
2080 #define MAX_TEXT_WARNINGS 5
2081
2082 /* State. */
2083 struct text_record
2084   {
2085     struct substring buffer;    /* Record contents. */
2086     size_t pos;                 /* Current position in buffer. */
2087     int n_warnings;             /* Number of warnings issued or suppressed. */
2088   };
2089
2090 /* Reads SIZE bytes into a text record for R,
2091    and returns the new text record. */
2092 static struct text_record *
2093 open_text_record (struct sfm_reader *r, size_t size)
2094 {
2095   struct text_record *text = pool_alloc (r->pool, sizeof *text);
2096   char *buffer = pool_malloc (r->pool, size + 1);
2097   read_bytes (r, buffer, size);
2098   text->buffer = ss_buffer (buffer, size);
2099   text->pos = 0;
2100   text->n_warnings = 0;
2101   return text;
2102 }
2103
2104 /* Closes TEXT, frees its storage, and issues a final warning
2105    about suppressed warnings if necesary. */
2106 static void
2107 close_text_record (struct sfm_reader *r, struct text_record *text)
2108 {
2109   if (text->n_warnings > MAX_TEXT_WARNINGS)
2110     sys_warn (r, _("Suppressed %d additional related warnings."),
2111               text->n_warnings - MAX_TEXT_WARNINGS);
2112   pool_free (r->pool, ss_data (text->buffer));
2113 }
2114
2115 /* Reads a variable=value pair from TEXT.
2116    Looks up the variable in DICT and stores it into *VAR.
2117    Stores a null-terminated value into *VALUE. */
2118 static bool
2119 read_variable_to_value_pair (struct sfm_reader *r, struct dictionary *dict,
2120                              struct text_record *text,
2121                              struct variable **var, char **value)
2122 {
2123   for (;;)
2124     {
2125       if (!text_read_short_name (r, dict, text, ss_cstr ("="), var))
2126         return false;
2127       
2128       *value = text_get_token (text, ss_buffer ("\t\0", 2), NULL);
2129       if (*value == NULL)
2130         return false;
2131
2132       text->pos += ss_span (ss_substr (text->buffer, text->pos, SIZE_MAX),
2133                             ss_buffer ("\t\0", 2));
2134
2135       if (*var != NULL)
2136         return true;
2137     }
2138 }
2139
2140 static bool
2141 text_read_variable_name (struct sfm_reader *r, struct dictionary *dict,
2142                          struct text_record *text, struct substring delimiters,
2143                          struct variable **var)
2144 {
2145   char *name;
2146
2147   name = text_get_token (text, delimiters, NULL);
2148   if (name == NULL)
2149     return false;
2150
2151   *var = dict_lookup_var (dict, name);
2152   if (*var != NULL)
2153     return true;
2154
2155   text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2156              name);
2157   return false;
2158 }
2159
2160
2161 static bool
2162 text_read_short_name (struct sfm_reader *r, struct dictionary *dict,
2163                       struct text_record *text, struct substring delimiters,
2164                       struct variable **var)
2165 {
2166   char *short_name = text_get_token (text, delimiters, NULL);
2167   if (short_name == NULL)
2168     return false;
2169
2170   *var = lookup_var_by_short_name (dict, short_name);
2171   if (*var == NULL)
2172     text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2173                short_name);
2174   return true;
2175 }
2176
2177 /* Displays a warning for the current file position, limiting the
2178    number to MAX_TEXT_WARNINGS for TEXT. */
2179 static void
2180 text_warn (struct sfm_reader *r, struct text_record *text,
2181            const char *format, ...)
2182 {
2183   if (text->n_warnings++ < MAX_TEXT_WARNINGS) 
2184     {
2185       va_list args;
2186
2187       va_start (args, format);
2188       sys_msg (r, MW, format, args);
2189       va_end (args);
2190     }
2191 }
2192
2193 static char *
2194 text_get_token (struct text_record *text, struct substring delimiters,
2195                 char *delimiter)
2196 {
2197   struct substring token;
2198   char *end;
2199
2200   if (!ss_tokenize (text->buffer, delimiters, &text->pos, &token))
2201     return NULL;
2202
2203   end = &ss_data (token)[ss_length (token)];
2204   if (delimiter != NULL)
2205     *delimiter = *end;
2206   *end = '\0';
2207   return ss_data (token);
2208 }
2209
2210 /* Reads a integer value expressed in decimal, then a space, then a string that
2211    consists of exactly as many bytes as specified by the integer, then a space,
2212    from TEXT.  Returns the string, null-terminated, as a subset of TEXT's
2213    buffer (so the caller should not free the string). */
2214 static const char *
2215 text_parse_counted_string (struct sfm_reader *r, struct text_record *text)
2216 {
2217   size_t start;
2218   size_t n;
2219   char *s;
2220
2221   start = text->pos;
2222   n = 0;
2223   for (;;)
2224     {
2225       int c = text->buffer.string[text->pos];
2226       if (c < '0' || c > '9')
2227         break;
2228       n = (n * 10) + (c - '0');
2229       text->pos++;
2230     }
2231   if (start == text->pos)
2232     {
2233       sys_warn (r, _("Expecting digit at offset %zu in MRSETS record."),
2234                  text->pos);
2235       return NULL;
2236     }
2237
2238   if (!text_match (text, ' '))
2239     {
2240       sys_warn (r, _("Expecting space at offset %zu in MRSETS record."),
2241                 text->pos);
2242       return NULL;
2243     }
2244
2245   if (text->pos + n > text->buffer.length)
2246     {
2247       sys_warn (r, _("%zu-byte string starting at offset %zu "
2248                      "exceeds record length %zu."),
2249                 n, text->pos, text->buffer.length);
2250       return NULL;
2251     }
2252
2253   s = &text->buffer.string[text->pos];
2254   if (s[n] != ' ')
2255     {
2256       sys_warn (r,
2257                 _("Expecting space at offset %zu following %zu-byte string."),
2258                 text->pos + n, n);
2259       return NULL;
2260     }
2261   s[n] = '\0';
2262   text->pos += n + 1;
2263   return s;
2264 }
2265
2266 static bool
2267 text_match (struct text_record *text, char c)
2268 {
2269   if (text->buffer.string[text->pos] == c) 
2270     {
2271       text->pos++;
2272       return true;
2273     }
2274   else
2275     return false;
2276 }
2277
2278 /* Returns the current byte offset inside the TEXT's string. */
2279 static size_t
2280 text_pos (const struct text_record *text)
2281 {
2282   return text->pos;
2283 }
2284 \f
2285 /* Messages. */
2286
2287 /* Displays a corruption message. */
2288 static void
2289 sys_msg (struct sfm_reader *r, int class, const char *format, va_list args)
2290 {
2291   struct msg m;
2292   struct string text;
2293
2294   ds_init_empty (&text);
2295   ds_put_format (&text, "`%s' near offset 0x%llx: ",
2296                  fh_get_file_name (r->fh), (long long int) ftello (r->file));
2297   ds_put_vformat (&text, format, args);
2298
2299   m.category = msg_class_to_category (class);
2300   m.severity = msg_class_to_severity (class);
2301   m.where.file_name = NULL;
2302   m.where.line_number = 0;
2303   m.where.first_column = 0;
2304   m.where.last_column = 0;
2305   m.text = ds_cstr (&text);
2306
2307   msg_emit (&m);
2308 }
2309
2310 /* Displays a warning for the current file position. */
2311 static void
2312 sys_warn (struct sfm_reader *r, const char *format, ...)
2313 {
2314   va_list args;
2315
2316   va_start (args, format);
2317   sys_msg (r, MW, format, args);
2318   va_end (args);
2319 }
2320
2321 /* Displays an error for the current file position,
2322    marks it as in an error state,
2323    and aborts reading it using longjmp. */
2324 static void
2325 sys_error (struct sfm_reader *r, const char *format, ...)
2326 {
2327   va_list args;
2328
2329   va_start (args, format);
2330   sys_msg (r, ME, format, args);
2331   va_end (args);
2332
2333   r->error = true;
2334   longjmp (r->bail_out, 1);
2335 }
2336 \f
2337 /* Reads BYTE_CNT bytes into BUF.
2338    Returns true if exactly BYTE_CNT bytes are successfully read.
2339    Aborts if an I/O error or a partial read occurs.
2340    If EOF_IS_OK, then an immediate end-of-file causes false to be
2341    returned; otherwise, immediate end-of-file causes an abort
2342    too. */
2343 static inline bool
2344 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
2345                    void *buf, size_t byte_cnt)
2346 {
2347   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
2348   if (bytes_read == byte_cnt)
2349     return true;
2350   else if (ferror (r->file))
2351     sys_error (r, _("System error: %s."), strerror (errno));
2352   else if (!eof_is_ok || bytes_read != 0)
2353     sys_error (r, _("Unexpected end of file."));
2354   else
2355     return false;
2356 }
2357
2358 /* Reads BYTE_CNT into BUF.
2359    Aborts upon I/O error or if end-of-file is encountered. */
2360 static void
2361 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2362 {
2363   read_bytes_internal (r, false, buf, byte_cnt);
2364 }
2365
2366 /* Reads BYTE_CNT bytes into BUF.
2367    Returns true if exactly BYTE_CNT bytes are successfully read.
2368    Returns false if an immediate end-of-file is encountered.
2369    Aborts if an I/O error or a partial read occurs. */
2370 static bool
2371 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2372 {
2373   return read_bytes_internal (r, true, buf, byte_cnt);
2374 }
2375
2376 /* Reads a 32-bit signed integer from R and returns its value in
2377    host format. */
2378 static int
2379 read_int (struct sfm_reader *r)
2380 {
2381   uint8_t integer[4];
2382   read_bytes (r, integer, sizeof integer);
2383   return integer_get (r->integer_format, integer, sizeof integer);
2384 }
2385
2386 /* Reads a 64-bit floating-point number from R and returns its
2387    value in host format. */
2388 static double
2389 read_float (struct sfm_reader *r)
2390 {
2391   uint8_t number[8];
2392   read_bytes (r, number, sizeof number);
2393   return float_get_double (r->float_format, number);
2394 }
2395
2396 /* Reads exactly SIZE - 1 bytes into BUFFER
2397    and stores a null byte into BUFFER[SIZE - 1]. */
2398 static void
2399 read_string (struct sfm_reader *r, char *buffer, size_t size)
2400 {
2401   assert (size > 0);
2402   read_bytes (r, buffer, size - 1);
2403   buffer[size - 1] = '\0';
2404 }
2405
2406 /* Skips BYTES bytes forward in R. */
2407 static void
2408 skip_bytes (struct sfm_reader *r, size_t bytes)
2409 {
2410   while (bytes > 0)
2411     {
2412       char buffer[1024];
2413       size_t chunk = MIN (sizeof buffer, bytes);
2414       read_bytes (r, buffer, chunk);
2415       bytes -= chunk;
2416     }
2417 }
2418 \f
2419 static const struct casereader_class sys_file_casereader_class =
2420   {
2421     sys_file_casereader_read,
2422     sys_file_casereader_destroy,
2423     NULL,
2424     NULL,
2425   };