Abstract the documents within a dictionary a little better. Thanks to
[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, DOC_LINE_LENGTH);
675   read_string (r, documents, DOC_LINE_LENGTH * line_cnt + 1);
676   if (strlen (documents) == DOC_LINE_LENGTH * line_cnt)
677     dict_set_documents (dict, documents);
678   else
679     sys_error (r, _("Document line contains null byte."));
680   pool_free (r->pool, documents);
681 }
682
683 /* Read a type 7 extension record. */
684 static void
685 read_extension_record (struct sfm_reader *r, struct dictionary *dict)
686 {
687   int subtype = read_int32 (r);
688   size_t size = read_int32 (r);
689   size_t count = read_int32 (r);
690   size_t bytes = size * count;
691
692   /* Check that SIZE * COUNT + 1 doesn't overflow.  Adding 1
693      allows an extra byte for a null terminator, used by some
694      extension processing routines. */
695   if (size != 0 && size_overflow_p (xsum (1, xtimes (count, size))))
696     sys_error (r, "Record type 7 subtype %d too large.", subtype);
697
698   switch (subtype)
699     {
700     case 3:
701       read_machine_int32_info (r, size, count);
702       return;
703
704     case 4:
705       read_machine_flt64_info (r, size, count);
706       return;
707
708     case 5:
709       /* Variable sets information.  We don't use these yet.
710          They only apply to GUIs; see VARSETS on the APPLY
711          DICTIONARY command in SPSS documentation. */
712       break;
713
714     case 6:
715       /* DATE variable information.  We don't use it yet, but we
716          should. */
717       break;
718                 
719     case 7:
720       /* Unknown purpose. */
721       break;
722       
723     case 11:
724       read_display_parameters (r, size, count, dict);
725       return;
726
727     case 13:
728       read_long_var_name_map (r, size, count, dict);
729       return;
730
731     case 14:
732       read_long_string_map (r, size, count, dict);
733       return;
734
735     case 16:
736       /* New in SPSS v14?  Unknown purpose.  */
737       break;
738
739     case 17:
740       /* Text field that defines variable attributes.  New in
741          SPSS 14. */
742       break;
743       
744     default:
745       sys_warn (r, _("Unrecognized record type 7, subtype %d."), subtype);
746       break;
747     }
748
749   skip_bytes (r, bytes);
750 }
751
752 /* Read record type 7, subtype 3. */
753 static void
754 read_machine_int32_info (struct sfm_reader *r, size_t size, size_t count)
755 {
756   int version_major UNUSED = read_int32 (r);
757   int version_minor UNUSED = read_int32 (r);
758   int version_revision UNUSED = read_int32 (r);
759   int machine_code UNUSED = read_int32 (r);
760   int float_representation = read_int32 (r);
761   int compression_code UNUSED = read_int32 (r);
762   int integer_representation = read_int32 (r);
763   int character_code UNUSED = read_int32 (r);
764
765   int expected_float_format;
766   int expected_integer_format;
767
768   if (size != 4 || count != 8)
769     sys_error (r, _("Bad size (%u) or count (%u) field on record type 7, "
770                     "subtype 3."),
771                (unsigned int) size, (unsigned int) count);
772
773   /* Check floating point format. */
774   if (r->float_format == FLOAT_IEEE_DOUBLE_BE
775       || r->float_format == FLOAT_IEEE_DOUBLE_LE)
776     expected_float_format = 1;
777   else if (r->float_format == FLOAT_Z_LONG)
778     expected_float_format = 2;
779   else if (r->float_format == FLOAT_VAX_G || r->float_format == FLOAT_VAX_D)
780     expected_float_format = 3;
781   else
782     NOT_REACHED ();
783   if (float_representation != expected_float_format)
784     sys_error (r, _("Floating-point representation indicated by "
785                     "system file (%d) differs from expected (%d)."),
786                r->float_format, expected_float_format);
787
788   /* Check integer format. */
789   if (r->integer_format == INTEGER_MSB_FIRST)
790     expected_integer_format = 1;
791   else if (r->integer_format == INTEGER_LSB_FIRST)
792     expected_integer_format = 2;
793   else
794     NOT_REACHED ();
795   if (integer_representation != expected_integer_format)
796     {
797       static const char *endian[] = {N_("little-endian"), N_("big-endian")};
798       sys_warn (r, _("Integer format indicated by system file (%s) "
799                      "differs from expected (%s)."),
800                 gettext (endian[integer_representation == 1]),
801                 gettext (endian[expected_integer_format == 1]));
802     }
803 }
804
805 /* Read record type 7, subtype 4. */
806 static void
807 read_machine_flt64_info (struct sfm_reader *r, size_t size, size_t count)
808 {
809   double sysmis = read_flt64 (r);
810   double highest = read_flt64 (r);
811   double lowest = read_flt64 (r);
812
813   if (size != 8 || count != 3)
814     sys_error (r, _("Bad size (%u) or count (%u) on extension 4."),
815                (unsigned int) size, (unsigned int) count);
816
817   if (sysmis != SYSMIS)
818     sys_warn (r, _("File specifies unexpected value %g as SYSMIS."), sysmis);
819   if (highest != HIGHEST)
820     sys_warn (r, _("File specifies unexpected value %g as HIGHEST."), highest);
821   if (lowest != LOWEST)
822     sys_warn (r, _("File specifies unexpected value %g as LOWEST."), lowest);
823 }
824
825 /* Read record type 7, subtype 11, which specifies how variables
826    should be displayed in GUI environments. */
827 static void
828 read_display_parameters (struct sfm_reader *r, size_t size, size_t count,
829                          struct dictionary *dict)
830 {
831   const size_t n_vars = count / 3 ;
832   bool warned = false;
833   int i;
834
835   if (count % 3 || n_vars != dict_get_var_cnt (dict)) 
836     sys_error (r, _("Bad size (%u) or count (%u) on extension 11."),
837                (unsigned int) size, (unsigned int) count);
838
839   for (i = 0; i < n_vars; ++i) 
840     {
841       int measure = read_int32 (r);
842       int width = read_int32 (r);
843       int align = read_int32 (r);
844       struct variable *v = dict_get_var (dict, i);
845
846       /* spss v14 sometimes seems to set string variables' measure to zero */
847       if ( 0 == measure && var_is_alpha (v) ) measure = 1;
848
849
850       if (measure < 1 || measure > 3 || align < 0 || align > 2)
851         {
852           if (!warned)
853             sys_warn (r, _("Invalid variable display parameters.  "
854                            "Default parameters substituted."));
855           warned = true;
856           continue;
857         }
858
859       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
860                            : measure == 2 ? MEASURE_ORDINAL
861                            : MEASURE_SCALE));
862       var_set_display_width (v, width);
863       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
864                              : align == 1 ? ALIGN_RIGHT
865                              : ALIGN_CENTRE));
866     }
867 }
868
869 /* Reads record type 7, subtype 13, which gives the long name
870    that corresponds to each short name.  Modifies variable names
871    in DICT accordingly.  */
872 static void
873 read_long_var_name_map (struct sfm_reader *r, size_t size, size_t count,
874                         struct dictionary *dict)
875 {
876   struct variable_to_value_map *map;
877   struct variable *var;
878   char *long_name;
879   int warning_cnt = 0;
880   
881   map = open_variable_to_value_map (r, size * count);
882   while (read_variable_to_value_map (r, dict, map, &var, &long_name,
883                                      &warning_cnt))
884     {
885       char short_name[SHORT_NAME_LEN + 1];
886       strcpy (short_name, var_get_short_name (var));
887
888       /* Validate long name. */
889       if (!var_is_valid_name (long_name, false))
890         {
891           sys_warn (r, _("Long variable mapping from %s to invalid "
892                          "variable name `%s'."),
893                     var_get_name (var), long_name);
894           continue;
895         }
896                       
897       /* Identify any duplicates. */
898       if (strcasecmp (short_name, long_name)
899           && dict_lookup_var (dict, long_name) != NULL)
900         {
901           sys_warn (r, _("Duplicate long variable name `%s' "
902                          "within system file."), long_name);
903           continue;
904         }
905
906       /* Set long name.  Renaming a variable may clear the short
907          name, but we want to retain it, so re-set it
908          explicitly. */
909       dict_rename_var (dict, var, long_name);
910       var_set_short_name (var, short_name);
911     }
912   close_variable_to_value_map (r, map);
913   r->has_long_var_names = true;
914 }
915
916 /* Reads record type 7, subtype 14, which gives the real length
917    of each very long string.  Rearranges DICT accordingly. */
918 static void
919 read_long_string_map (struct sfm_reader *r, size_t size, size_t count,
920                       struct dictionary *dict)
921 {
922   struct variable_to_value_map *map;
923   struct variable *var;
924   char *length_s;
925   int warning_cnt = 0;
926
927   r->has_vls = true;
928
929   map = open_variable_to_value_map (r, size * count);
930   while (read_variable_to_value_map (r, dict, map, &var, &length_s,
931                                      &warning_cnt))
932     {
933       long length, remaining_length;
934       size_t idx;
935
936       /* Get length. */
937       length = strtol (length_s, NULL, 10);
938       if (length < MIN_VERY_LONG_STRING || length == LONG_MAX) 
939         {
940           sys_warn (r, _("%s listed as string of length %s "
941                          "in length table."),
942                     var_get_name (var), length_s);
943           continue;
944         }
945
946       /* Group multiple variables into single variable
947          and delete all but the first. */
948       remaining_length = length;
949       for (idx = var_get_dict_index (var); remaining_length > 0; idx++)
950         if (idx < dict_get_var_cnt (dict)) 
951           remaining_length -= MIN (var_get_width (dict_get_var (dict, idx)),
952                                    EFFECTIVE_LONG_STRING_LENGTH);
953         else
954           sys_error (r, _("Very long string %s overflows dictionary."),
955                      var_get_name (var));
956       dict_delete_consecutive_vars (dict,
957                                     var_get_dict_index (var) + 1,
958                                     idx - var_get_dict_index (var) - 1);
959
960       /* Assign all the length to the first variable. */
961       var_set_width (var, length);
962     }
963   close_variable_to_value_map (r, map);
964   dict_compact_values (dict);
965 }
966
967 /* Reads value labels from sysfile H and inserts them into the
968    associated dictionary. */
969 static void
970 read_value_labels (struct sfm_reader *r,
971                    struct dictionary *dict, struct variable **var_by_value_idx)
972 {
973   struct pool *subpool;
974   
975   struct label 
976     {
977       char raw_value[8];        /* Value as uninterpreted bytes. */
978       union value value;        /* Value. */
979       char *label;              /* Null-terminated label string. */
980     };
981
982   struct label *labels = NULL;
983   int label_cnt;                /* Number of labels. */
984
985   struct variable **var = NULL; /* Associated variables. */
986   int var_cnt;                  /* Number of associated variables. */
987
988   int i;
989
990   subpool = pool_create_subpool (r->pool);
991
992   /* Read the type 3 record and record its contents.  We can't do
993      much with the data yet because we don't know whether it is
994      of numeric or string type. */
995
996   /* Read number of labels. */
997   label_cnt = read_int32 (r);
998
999   if (label_cnt >= INT32_MAX / sizeof *labels)
1000     {    
1001       sys_warn (r, _("Invalid number of labels: %d.  Ignoring labels."),
1002                 label_cnt);
1003       label_cnt = 0;
1004     }
1005
1006   /* Read each value/label tuple into labels[]. */
1007   labels = pool_nalloc (subpool, label_cnt, sizeof *labels);
1008   for (i = 0; i < label_cnt; i++)
1009     {
1010       struct label *label = labels + i;
1011       unsigned char label_len;
1012       size_t padded_len;
1013
1014       /* Read value. */
1015       read_bytes (r, label->raw_value, sizeof label->raw_value);
1016
1017       /* Read label length. */
1018       read_bytes (r, &label_len, sizeof label_len);
1019       padded_len = ROUND_UP (label_len + 1, 8);
1020
1021       /* Read label, padding. */
1022       label->label = pool_alloc (subpool, padded_len + 1);
1023       read_bytes (r, label->label, padded_len - 1);
1024       label->label[label_len] = 0;
1025     }
1026
1027   /* Now, read the type 4 record that has the list of variables
1028      to which the value labels are to be applied. */
1029
1030   /* Read record type of type 4 record. */
1031   if (read_int32 (r) != 4)
1032     sys_error (r, _("Variable index record (type 4) does not immediately "
1033                     "follow value label record (type 3) as it should."));
1034
1035   /* Read number of variables associated with value label from type 4
1036      record. */
1037   var_cnt = read_int32 (r);
1038   if (var_cnt < 1 || var_cnt > dict_get_var_cnt (dict))
1039     sys_error (r, _("Number of variables associated with a value label (%d) "
1040                     "is not between 1 and the number of variables (%u)."),
1041                var_cnt, (unsigned int) dict_get_var_cnt (dict));
1042
1043   /* Read the list of variables. */
1044   var = pool_nalloc (subpool, var_cnt, sizeof *var);
1045   for (i = 0; i < var_cnt; i++)
1046     {
1047       var[i] = lookup_var_by_value_idx (r, var_by_value_idx, read_int32 (r));
1048       if (var_is_long_string (var[i]))
1049         sys_error (r, _("Value labels are not allowed on long string "
1050                         "variables (%s)."), var_get_name (var[i]));
1051     }
1052
1053   /* Type check the variables. */
1054   for (i = 1; i < var_cnt; i++)
1055     if (var_get_type (var[i]) != var_get_type (var[0]))
1056       sys_error (r, _("Variables associated with value label are not all of "
1057                       "identical type.  Variable %s is %s, but variable "
1058                       "%s is %s."),
1059                  var_get_name (var[0]),
1060                  var_is_numeric (var[0]) ? _("numeric") : _("string"),
1061                  var_get_name (var[i]),
1062                  var_is_numeric (var[i]) ? _("numeric") : _("string"));
1063
1064   /* Fill in labels[].value, now that we know the desired type. */
1065   for (i = 0; i < label_cnt; i++) 
1066     {
1067       struct label *label = labels + i;
1068       
1069       if (var_is_alpha (var[0]))
1070         buf_copy_rpad (label->value.s, sizeof label->value.s,
1071                        label->raw_value, sizeof label->raw_value);
1072       else
1073         label->value.f = flt64_to_double (r, (uint8_t *) label->raw_value);
1074     }
1075   
1076   /* Assign the `value_label's to each variable. */
1077   for (i = 0; i < var_cnt; i++)
1078     {
1079       struct variable *v = var[i];
1080       int j;
1081
1082       /* Add each label to the variable. */
1083       for (j = 0; j < label_cnt; j++)
1084         {
1085           struct label *label = &labels[j];
1086           if (!var_add_value_label (v, &label->value, label->label)) 
1087             {
1088               if (var_is_numeric (var[0]))
1089                 sys_warn (r, _("Duplicate value label for %g on %s."),
1090                           label->value.f, var_get_name (v));
1091               else
1092                 sys_warn (r, _("Duplicate value label for \"%.*s\" on %s."),
1093                           var_get_width (v), label->value.s,
1094                           var_get_name (v)); 
1095             }
1096         }
1097     }
1098
1099   pool_destroy (subpool);
1100 }
1101 \f
1102 /* Case reader. */
1103
1104 static void partial_record (struct sfm_reader *r)
1105      NO_RETURN;
1106 static bool read_case_number (struct sfm_reader *, double *);
1107 static bool read_case_string (struct sfm_reader *, char *, size_t);
1108 static int read_opcode (struct sfm_reader *);
1109 static bool read_compressed_number (struct sfm_reader *, double *);
1110 static bool read_compressed_string (struct sfm_reader *, char *);
1111 static bool read_whole_strings (struct sfm_reader *, char *, size_t);
1112
1113 /* Reads one case from READER's file into C.  Returns nonzero
1114    only if successful. */
1115 int
1116 sfm_read_case (struct sfm_reader *r, struct ccase *c)
1117 {
1118   if (r->error)
1119     return 0;
1120
1121   if (setjmp (r->bail_out))
1122     return 0;
1123
1124   if (!r->compressed && sizeof (double) == 8 && !r->has_vls) 
1125     {
1126       /* Fast path.  Read the whole case directly. */
1127       if (!try_read_bytes (r, case_data_all_rw (c),
1128                          sizeof (union value) * r->value_cnt))
1129         return 0;
1130
1131       /* Convert floating point numbers to native format if needed. */
1132       if (r->float_format != FLOAT_NATIVE_DOUBLE) 
1133         {
1134           int i;
1135           
1136           for (i = 0; i < r->var_cnt; i++) 
1137             if (r->vars[i].width == 0) 
1138               {
1139                 double *d = &case_data_rw_idx (c, r->vars[i].case_index)->f;
1140                 float_convert (r->float_format, d, FLOAT_NATIVE_DOUBLE, d); 
1141               }
1142         }
1143       return 1;
1144     }
1145   else 
1146     {
1147       /* Slow path.  Convert from external to internal format. */
1148       int i;
1149
1150       for (i = 0; i < r->var_cnt; i++)
1151         {
1152           struct sfm_var *sv = &r->vars[i];
1153           union value *v = case_data_rw_idx (c, sv->case_index);
1154
1155           if (sv->width == 0) 
1156             {
1157               if (!read_case_number (r, &v->f))
1158                 goto eof; 
1159             }
1160           else
1161             {
1162               /* Read the string data in segments up to 255 bytes
1163                  at a time, packed into 8-byte units. */
1164               const int max_chunk = MIN_VERY_LONG_STRING - 1;
1165               int ofs, chunk_size;
1166               for (ofs = 0; ofs < sv->width; ofs += chunk_size)
1167                 {
1168                   chunk_size = MIN (max_chunk, sv->width - ofs);
1169                   if (!read_case_string (r, v->s + ofs, chunk_size)) 
1170                     {
1171                       if (ofs)
1172                         partial_record (r);
1173                       goto eof; 
1174                     }
1175                 }
1176
1177               /* Very long strings have trailing wasted space
1178                  that we must skip. */
1179               if (sv->width >= MIN_VERY_LONG_STRING) 
1180                 {
1181                   int bytes_read = (sv->width / max_chunk * 256
1182                                     + ROUND_UP (sv->width % max_chunk, 8));
1183                   int total_bytes = sfm_width_to_bytes (sv->width);
1184                   int excess_bytes = total_bytes - bytes_read;
1185
1186                   while (excess_bytes > 0) 
1187                     {
1188                       char buffer[1024];
1189                       size_t chunk = MIN (sizeof buffer, excess_bytes);
1190                       if (!read_whole_strings (r, buffer, chunk))
1191                         partial_record (r);
1192                       excess_bytes -= chunk;
1193                     }
1194                 }
1195             }
1196         }
1197       return 1; 
1198
1199     eof:
1200       if (i != 0)
1201         partial_record (r);
1202       return 0;
1203     }
1204 }
1205
1206 /* Issues an error that R ends in a partial record. */
1207 static void
1208 partial_record (struct sfm_reader *r)
1209 {
1210   sys_error (r, _("File ends in partial case."));
1211 }
1212
1213 /* Reads a number from R and stores its value in *D.
1214    If R is compressed, reads a compressed number;
1215    otherwise, reads a number in the regular way.
1216    Returns true if successful, false if end of file is
1217    reached immediately. */
1218 static bool
1219 read_case_number (struct sfm_reader *r, double *d) 
1220 {
1221   if (!r->compressed)
1222     {
1223       uint8_t flt64[8];
1224       if (!try_read_bytes (r, flt64, sizeof flt64))
1225         return false;
1226       *d = flt64_to_double (r, flt64);
1227       return true;
1228     }
1229   else
1230     return read_compressed_number (r, d);
1231 }
1232
1233 /* Reads LENGTH string bytes from R into S.
1234    Always reads a multiple of 8 bytes; if LENGTH is not a
1235    multiple of 8, then extra bytes are read and discarded without
1236    being written to S.
1237    Reads compressed strings if S is compressed.
1238    Returns true if successful, false if end of file is
1239    reached immediately. */
1240 static bool
1241 read_case_string (struct sfm_reader *r, char *s, size_t length) 
1242 {
1243   size_t whole = ROUND_DOWN (length, 8);
1244   size_t partial = length % 8;
1245   
1246   if (whole) 
1247     {
1248       if (!read_whole_strings (r, s, whole))
1249         return false;
1250     }
1251
1252   if (partial)
1253     {
1254       char bounce[8];
1255       if (!read_whole_strings (r, bounce, sizeof bounce))
1256         {
1257           if (whole)
1258             partial_record (r);
1259           return false; 
1260         }
1261       memcpy (s + whole, bounce, partial);
1262     }
1263
1264   return true;
1265 }
1266
1267 /* Reads and returns the next compression opcode from R. */
1268 static int
1269 read_opcode (struct sfm_reader *r) 
1270 {
1271   assert (r->compressed);
1272   for (;;)
1273     {
1274       int opcode;
1275       if (r->opcode_idx >= sizeof r->opcodes) 
1276         {
1277           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
1278             return -1;
1279           r->opcode_idx = 0;
1280         }
1281       opcode = r->opcodes[r->opcode_idx++];
1282
1283       if (opcode != 0)
1284         return opcode;
1285     }
1286 }
1287
1288 /* Reads a compressed number from R and stores its value in D.
1289    Returns true if successful, false if end of file is
1290    reached immediately. */
1291 static bool
1292 read_compressed_number (struct sfm_reader *r, double *d)
1293 {
1294   int opcode = read_opcode (r); 
1295   switch (opcode)
1296     {
1297     case -1:
1298     case 252:
1299       return false;
1300
1301     case 253:
1302       *d = read_flt64 (r);
1303       break;
1304       
1305     case 254:
1306       sys_error (r, _("Compressed data is corrupt."));
1307
1308     case 255:
1309       *d = SYSMIS;
1310       break;
1311
1312     default:
1313       *d = opcode - r->bias;
1314       break;
1315     }
1316
1317   return true;
1318 }
1319
1320 /* Reads a compressed 8-byte string segment from R and stores it
1321    in DST.
1322    Returns true if successful, false if end of file is
1323    reached immediately. */
1324 static bool
1325 read_compressed_string (struct sfm_reader *r, char *dst)
1326 {
1327   switch (read_opcode (r))
1328     {
1329     case -1:
1330     case 252:
1331       return false;
1332
1333     case 253:
1334       read_bytes (r, dst, 8);
1335       break;
1336
1337     case 254:
1338       memset (dst, ' ', 8);
1339       break;
1340
1341     default:
1342       sys_error (r, _("Compressed data is corrupt."));
1343     }
1344
1345   return true;
1346 }
1347
1348 /* Reads LENGTH string bytes from R into S.
1349    LENGTH must be a multiple of 8.
1350    Reads compressed strings if S is compressed.
1351    Returns true if successful, false if end of file is
1352    reached immediately. */
1353 static bool
1354 read_whole_strings (struct sfm_reader *r, char *s, size_t length)
1355 {
1356   assert (length % 8 == 0);
1357   if (!r->compressed)
1358     return try_read_bytes (r, s, length);
1359   else
1360     {
1361       size_t ofs;
1362       for (ofs = 0; ofs < length; ofs += 8)
1363         if (!read_compressed_string (r, s + ofs)) 
1364           {
1365             if (ofs != 0)
1366               partial_record (r);
1367             return false;
1368           }
1369       return true;
1370     }
1371 }
1372 \f
1373 /* Creates and returns a table that can be used for translating a value
1374    index into a case to a "struct variable *" for DICT.  Multiple
1375    system file fields reference variables this way.
1376
1377    This table must be created before processing the very long
1378    string extension record, because that record causes some
1379    values to be deleted from the case and the dictionary to be
1380    compacted. */
1381 static struct variable **
1382 make_var_by_value_idx (struct sfm_reader *r, struct dictionary *dict) 
1383 {
1384   struct variable **var_by_value_idx;
1385   int value_idx = 0;
1386   int i;
1387
1388   var_by_value_idx = pool_nmalloc (r->pool,
1389                                    r->value_cnt, sizeof *var_by_value_idx);
1390   for (i = 0; i < dict_get_var_cnt (dict); i++) 
1391     {
1392       struct variable *v = dict_get_var (dict, i);
1393       int nv = var_is_numeric (v) ? 1 : DIV_RND_UP (var_get_width (v), 8);
1394       int j;
1395
1396       var_by_value_idx[value_idx++] = v;
1397       for (j = 1; j < nv; j++)
1398         var_by_value_idx[value_idx++] = NULL;
1399     }
1400   assert (value_idx == r->value_cnt);
1401
1402   return var_by_value_idx;
1403 }
1404
1405 /* Returns the "struct variable" corresponding to the given
1406    1-basd VALUE_IDX in VAR_BY_VALUE_IDX.  Verifies that the index
1407    is valid. */
1408 static struct variable *
1409 lookup_var_by_value_idx (struct sfm_reader *r,
1410                          struct variable **var_by_value_idx, int value_idx) 
1411 {
1412   struct variable *var;
1413   
1414   if (value_idx < 1 || value_idx > r->value_cnt)
1415     sys_error (r, _("Variable index %d not in valid range 1...%d."),
1416                value_idx, r->value_cnt);
1417
1418   var = var_by_value_idx[value_idx - 1];
1419   if (var == NULL)
1420     sys_error (r, _("Variable index %d refers to long string "
1421                     "continuation."),
1422                value_idx);
1423
1424   return var;
1425 }
1426
1427 /* Returns the variable in D with the given SHORT_NAME,
1428    or a null pointer if there is none. */
1429 static struct variable *
1430 lookup_var_by_short_name (struct dictionary *d, const char *short_name)
1431 {
1432   struct variable *var;
1433   size_t var_cnt;
1434   size_t i;
1435
1436   /* First try looking up by full name.  This often succeeds. */
1437   var = dict_lookup_var (d, short_name);
1438   if (var != NULL && !strcasecmp (var_get_short_name (var), short_name))
1439     return var;
1440
1441   /* Iterate through the whole dictionary as a fallback. */
1442   var_cnt = dict_get_var_cnt (d);
1443   for (i = 0; i < var_cnt; i++) 
1444     {
1445       var = dict_get_var (d, i);
1446       if (!strcasecmp (var_get_short_name (var), short_name))
1447         return var;
1448     }
1449
1450   return NULL;
1451 }
1452 \f
1453 /* Helpers for reading records that contain "variable=value"
1454    pairs. */
1455
1456 /* State. */
1457 struct variable_to_value_map 
1458   {
1459     struct substring buffer;    /* Record contents. */
1460     size_t pos;                 /* Current position in buffer. */
1461   };
1462
1463 /* Reads SIZE bytes into a "variable=value" map for R,
1464    and returns the map. */
1465 static struct variable_to_value_map *
1466 open_variable_to_value_map (struct sfm_reader *r, size_t size) 
1467 {
1468   struct variable_to_value_map *map = pool_alloc (r->pool, sizeof *map);
1469   char *buffer = pool_malloc (r->pool, size + 1);
1470   read_bytes (r, buffer, size);
1471   map->buffer = ss_buffer (buffer, size);
1472   map->pos = 0;
1473   return map;
1474 }
1475
1476 /* Closes MAP and frees its storage.
1477    Not really needed, because the pool will free the map anyway,
1478    but can be used to free it earlier. */
1479 static void
1480 close_variable_to_value_map (struct sfm_reader *r,
1481                              struct variable_to_value_map *map) 
1482 {
1483   pool_free (r->pool, ss_data (map->buffer));
1484 }
1485
1486 /* Reads the next variable=value pair from MAP.
1487    Looks up the variable in DICT and stores it into *VAR.
1488    Stores a null-terminated value into *VALUE. */
1489 static bool
1490 read_variable_to_value_map (struct sfm_reader *r, struct dictionary *dict,
1491                             struct variable_to_value_map *map,
1492                             struct variable **var, char **value,
1493                             int *warning_cnt) 
1494 {
1495   int max_warnings = 5;
1496   
1497   for (;;) 
1498     {
1499       struct substring short_name_ss, value_ss;
1500
1501       if (!ss_tokenize (map->buffer, ss_cstr ("="), &map->pos, &short_name_ss)
1502           || !ss_tokenize (map->buffer, ss_buffer ("\t\0", 2), &map->pos,
1503                            &value_ss)) 
1504         {
1505           if (*warning_cnt > max_warnings)
1506             sys_warn (r, _("Suppressed %d additional variable map warnings."),
1507                       *warning_cnt - max_warnings);
1508           return false; 
1509         }
1510       
1511       map->pos += ss_span (ss_substr (map->buffer, map->pos, SIZE_MAX),
1512                            ss_buffer ("\t\0", 2));
1513
1514       ss_data (short_name_ss)[ss_length (short_name_ss)] = '\0';
1515       *var = lookup_var_by_short_name (dict, ss_data (short_name_ss));
1516       if (*var == NULL)
1517         {
1518           if (++*warning_cnt <= 5)
1519             sys_warn (r, _("Variable map refers to unknown variable %s."),
1520                       ss_data (short_name_ss));
1521           continue;
1522         }
1523
1524       ss_data (value_ss)[ss_length (value_ss)] = '\0';
1525       *value = ss_data (value_ss);
1526
1527       return true;
1528     }
1529 }
1530 \f
1531 /* Messages. */
1532
1533 /* Displays a corruption message. */
1534 static void
1535 sys_msg (struct sfm_reader *r, int class, const char *format, va_list args)
1536 {
1537   struct msg m;
1538   struct string text;
1539
1540   ds_init_empty (&text);
1541   ds_put_format (&text, "\"%s\" near offset 0x%lx: ",
1542                  fh_get_file_name (r->fh), (unsigned long) ftell (r->file));
1543   ds_put_vformat (&text, format, args);
1544
1545   m.category = msg_class_to_category (class);
1546   m.severity = msg_class_to_severity (class);
1547   m.where.file_name = NULL;
1548   m.where.line_number = 0;
1549   m.text = ds_cstr (&text);
1550
1551   msg_emit (&m);
1552 }
1553
1554 /* Displays a warning for the current file position. */
1555 static void
1556 sys_warn (struct sfm_reader *r, const char *format, ...) 
1557 {
1558   va_list args;
1559   
1560   va_start (args, format);
1561   sys_msg (r, MW, format, args);
1562   va_end (args);
1563 }
1564
1565 /* Displays an error for the current file position,
1566    marks it as in an error state,
1567    and aborts reading it using longjmp. */
1568 static void
1569 sys_error (struct sfm_reader *r, const char *format, ...) 
1570 {
1571   va_list args;
1572   
1573   va_start (args, format);
1574   sys_msg (r, ME, format, args);
1575   va_end (args);
1576
1577   r->error = true;
1578   longjmp (r->bail_out, 1);
1579 }
1580 \f
1581 /* Reads BYTE_CNT bytes into BUF.
1582    Returns true if exactly BYTE_CNT bytes are successfully read.
1583    Aborts if an I/O error or a partial read occurs.
1584    If EOF_IS_OK, then an immediate end-of-file causes false to be
1585    returned; otherwise, immediate end-of-file causes an abort
1586    too. */
1587 static inline bool
1588 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
1589                    void *buf, size_t byte_cnt)
1590 {
1591   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
1592   if (bytes_read == byte_cnt)
1593     return true;
1594   else if (ferror (r->file))
1595     sys_error (r, _("System error: %s."), strerror (errno));
1596   else if (!eof_is_ok || bytes_read != 0)
1597     sys_error (r, _("Unexpected end of file."));
1598   else
1599     return false;
1600 }
1601
1602 /* Reads BYTE_CNT into BUF.
1603    Aborts upon I/O error or if end-of-file is encountered. */
1604 static void
1605 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
1606 {
1607   read_bytes_internal (r, false, buf, byte_cnt);
1608 }
1609
1610 /* Reads BYTE_CNT bytes into BUF.
1611    Returns true if exactly BYTE_CNT bytes are successfully read.
1612    Returns false if an immediate end-of-file is encountered.
1613    Aborts if an I/O error or a partial read occurs. */
1614 static bool
1615 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
1616 {
1617   return read_bytes_internal (r, true, buf, byte_cnt);
1618 }
1619
1620 /* Reads a 32-bit signed integer from R and returns its value in
1621    host format. */
1622 static int32_t
1623 read_int32 (struct sfm_reader *r) 
1624 {
1625   uint8_t int32[4];
1626   read_bytes (r, int32, sizeof int32);
1627   return int32_to_native (r, int32);
1628 }
1629
1630 /* Reads a 64-bit floating-point number from R and returns its
1631    value in host format. */
1632 static double
1633 read_flt64 (struct sfm_reader *r) 
1634 {
1635   uint8_t flt64[8];
1636   read_bytes (r, flt64, sizeof flt64);
1637   return flt64_to_double (r, flt64);
1638 }
1639
1640 /* Reads exactly SIZE - 1 bytes into BUFFER
1641    and stores a null byte into BUFFER[SIZE - 1]. */
1642 static void
1643 read_string (struct sfm_reader *r, char *buffer, size_t size) 
1644 {
1645   assert (size > 0);
1646   read_bytes (r, buffer, size - 1);
1647   buffer[size - 1] = '\0';
1648 }
1649
1650 /* Skips BYTES bytes forward in R. */
1651 static void
1652 skip_bytes (struct sfm_reader *r, size_t bytes)
1653 {
1654   while (bytes > 0) 
1655     {
1656       char buffer[1024];
1657       size_t chunk = MIN (sizeof buffer, bytes);
1658       read_bytes (r, buffer, chunk);
1659       bytes -= chunk;
1660     }
1661 }
1662 \f
1663 /* Returns the value of the 32-bit signed integer at INT32,
1664    converted from the format used by R to the host format. */
1665 static int32_t
1666 int32_to_native (const struct sfm_reader *r, const uint8_t int32[4]) 
1667 {
1668   int32_t x;
1669   if (r->integer_format == INTEGER_NATIVE)
1670     memcpy (&x, int32, sizeof x);
1671   else
1672     x = integer_get (r->integer_format, int32, sizeof x);
1673   return x;
1674 }
1675
1676 /* Returns the value of the 64-bit floating point number at
1677    FLT64, converted from the format used by R to the host
1678    format. */
1679 static double
1680 flt64_to_double (const struct sfm_reader *r, const uint8_t flt64[8])
1681 {
1682   double x;
1683   if (r->float_format == FLOAT_NATIVE_DOUBLE)
1684     memcpy (&x, flt64, sizeof x);
1685   else
1686     float_convert (r->float_format, flt64, FLOAT_NATIVE_DOUBLE, &x);
1687   return x;
1688 }
1689