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