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