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