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