Finish converting struct variable to an opaque type. In this
[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    Written by Ben Pfaff <blp@gnu.org>.
4
5    This program is free software; you can redistribute it and/or
6    modify it under the terms of the GNU General Public License as
7    published by the Free Software Foundation; either version 2 of the
8    License, or (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful, but
11    WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
18    02110-1301, USA. */
19
20 #include <config.h>
21
22 #include "sys-file-reader.h"
23 #include "sfm-private.h"
24 #include "sys-file-private.h"
25
26 #include <stdlib.h>
27 #include <errno.h>
28 #include <float.h>
29 #include <c-ctype.h>
30 #include <minmax.h>
31
32 #include <libpspp/alloc.h>
33 #include <libpspp/assertion.h>
34 #include <libpspp/message.h>
35 #include <libpspp/compiler.h>
36 #include <libpspp/magic.h>
37 #include <libpspp/misc.h>
38 #include <libpspp/str.h>
39 #include <libpspp/hash.h>
40 #include <libpspp/array.h>
41
42 #include "case.h"
43 #include "dictionary.h"
44 #include "file-handle-def.h"
45 #include "file-name.h"
46 #include "format.h"
47 #include "missing-values.h"
48 #include "value-labels.h"
49 #include "value.h"
50 #include "variable.h"
51
52 #include "gettext.h"
53 #define _(msgid) gettext (msgid)
54
55 /* System file reader. */
56 struct sfm_reader
57 {
58   struct file_handle *fh;     /* File handle. */
59   FILE *file;                   /* File stream. */
60
61   int reverse_endian;           /* 1=file has endianness opposite us. */
62   int value_cnt;                /* Number of `union values's per case. */
63   long case_cnt;                /* Number of cases, -1 if unknown. */
64   int compressed;               /* 1=compressed, 0=not compressed. */
65   double bias;                  /* Compression bias, usually 100.0. */
66   int weight_idx;               /* 0-based index of weighting variable, or -1. */
67   bool ok;                    /* False after an I/O error or corrupt data. */
68   bool has_vls;         /* True if the file has one or more Very Long Strings*/
69
70   /* Variables. */
71   struct sfm_var *vars;
72   size_t var_cnt;
73
74   /* File's special constants. */
75   flt64 sysmis;
76   flt64 highest;
77   flt64 lowest;
78
79   /* Decompression buffer. */
80   flt64 *buf;                   /* Buffer data. */
81   flt64 *ptr;                   /* Current location in buffer. */
82   flt64 *end;                   /* End of buffer data. */
83
84   /* Compression instruction octet. */
85   unsigned char x[8];         /* Current instruction octet. */
86   unsigned char *y;             /* Location in current instruction octet. */
87 };
88
89 /* A variable in a system file. */
90 struct sfm_var 
91 {
92   int width;                  /* 0=numeric, otherwise string width. */
93   int fv;                     /* Index into case. */
94 };
95 \f
96 /* Utilities. */
97
98 /* Swap bytes *A and *B. */
99 static inline void
100 bswap (char *a, char *b) 
101 {
102   char t = *a;
103   *a = *b;
104   *b = t;
105 }
106
107 /* Reverse the byte order of 32-bit integer *X. */
108 static inline void
109 bswap_int32 (int32_t *x_)
110 {
111   char *x = (char *) x_;
112   bswap (x + 0, x + 3);
113   bswap (x + 1, x + 2);
114 }
115
116 /* Reverse the byte order of 64-bit floating point *X. */
117 static inline void
118 bswap_flt64 (flt64 *x_)
119 {
120   char *x = (char *) x_;
121   bswap (x + 0, x + 7);
122   bswap (x + 1, x + 6);
123   bswap (x + 2, x + 5);
124   bswap (x + 3, x + 4);
125 }
126
127 static void
128 corrupt_msg (int class, const char *format,...)
129      PRINTF_FORMAT (2, 3);
130
131      /* Displays a corrupt sysfile error. */
132      static void
133      corrupt_msg (int class, const char *format,...)
134 {
135   struct msg m;
136   va_list args;
137   struct string text;
138
139   ds_init_cstr (&text, _("corrupt system file: "));
140   va_start (args, format);
141   ds_put_vformat (&text, format, args);
142   va_end (args);
143
144   m.category = msg_class_to_category (class);
145   m.severity = msg_class_to_severity (class);
146   m.where.file_name = NULL;
147   m.where.line_number = 0;
148   m.text = ds_cstr (&text);
149
150   msg_emit (&m);
151 }
152
153 /* Closes a system file after we're done with it. */
154 void
155 sfm_close_reader (struct sfm_reader *r)
156 {
157   if (r == NULL)
158     return;
159
160   if (r->file)
161     {
162       if (fn_close (fh_get_file_name (r->fh), r->file) == EOF)
163         msg (ME, _("%s: Closing system file: %s."),
164              fh_get_file_name (r->fh), strerror (errno));
165       r->file = NULL;
166     }
167
168   if (r->fh != NULL)
169     fh_close (r->fh, "system file", "rs");
170
171   free (r->vars);
172   free (r->buf);
173   free (r);
174 }
175 \f
176 /* Dictionary reader. */
177
178 static void buf_unread(struct sfm_reader *r, size_t byte_cnt);
179
180 static void *buf_read (struct sfm_reader *, void *buf, size_t byte_cnt,
181                        size_t min_alloc);
182
183 static int read_header (struct sfm_reader *,
184                         struct dictionary *, struct sfm_read_info *);
185 static int parse_format_spec (struct sfm_reader *, int32_t,
186                               struct fmt_spec *, const struct variable *);
187 static int read_value_labels (struct sfm_reader *, struct dictionary *,
188                               struct variable **var_by_idx);
189 static int read_variables (struct sfm_reader *,
190                            struct dictionary *, struct variable ***var_by_idx);
191 static int read_machine_int32_info (struct sfm_reader *, int size, int count);
192 static int read_machine_flt64_info (struct sfm_reader *, int size, int count);
193 static int read_documents (struct sfm_reader *, struct dictionary *);
194
195 static int fread_ok (struct sfm_reader *, void *, size_t);
196
197 /* Displays the message X with corrupt_msg, then jumps to the error
198    label. */
199 #define lose(X)                                 \
200         do {                                    \
201             corrupt_msg X;                      \
202             goto error;                         \
203         } while (0)
204
205 /* Calls buf_read with the specified arguments, and jumps to
206    error if the read fails. */
207 #define assertive_buf_read(a,b,c,d)             \
208         do {                                    \
209             if (!buf_read (a,b,c,d))            \
210               goto error;                       \
211         } while (0)
212
213
214 struct name_pair
215 {
216   char *shortname;
217   char *longname;
218 };
219
220 static int
221 pair_sn_compare(const void *_p1, const void *_p2, const void *aux UNUSED)
222 {
223   int i;
224
225   const struct name_pair *p1 = _p1;
226   const struct name_pair *p2 = _p2;
227
228   char buf1[SHORT_NAME_LEN + 1];
229   char buf2[SHORT_NAME_LEN + 1];
230
231   memset(buf1, 0, SHORT_NAME_LEN + 1);
232   memset(buf2, 0, SHORT_NAME_LEN + 1);
233
234   for (i = 0 ; i <= SHORT_NAME_LEN ; ++i ) 
235     {
236       buf1[i] = p1->shortname[i];
237       if ( '\0' == buf1[i]) 
238         break;
239     }
240
241   for (i = 0 ; i <= SHORT_NAME_LEN ; ++i ) 
242     {
243       buf2[i] = p2->shortname[i];
244       if ( '\0' == buf2[i]) 
245         break;
246     }
247
248   return strncmp(buf1, buf2, SHORT_NAME_LEN);
249 }
250
251 static unsigned int
252 pair_sn_hash(const void *_p, const void *aux UNUSED)
253 {
254   int i;
255   const struct name_pair *p = _p;
256   char buf[SHORT_NAME_LEN + 1];
257
258   memset(buf, 0, SHORT_NAME_LEN + 1); 
259   for (i = 0 ; i <= SHORT_NAME_LEN ; ++i ) 
260     {
261       buf[i] = p->shortname[i];
262       if ( '\0' == buf[i]) 
263         break;
264     }
265
266   return hsh_hash_bytes(buf, strlen(buf));
267 }
268
269 static void
270 pair_sn_free(void *p, const void *aux UNUSED)
271 {
272   free(p);
273 }
274
275
276
277 /* Opens the system file designated by file handle FH for
278    reading.  Reads the system file's dictionary into *DICT.
279    If INFO is non-null, then it receives additional info about the
280    system file. */
281 struct sfm_reader *
282 sfm_open_reader (struct file_handle *fh, struct dictionary **dict,
283                  struct sfm_read_info *info)
284 {
285   struct sfm_reader *r = NULL;
286   struct variable **var_by_idx = NULL;
287
288   /* The data in record 7(14) */
289   char *subrec14data = 0;
290
291   /* A hash table of long variable names indexed by short name */
292   struct hsh_table *short_to_long = NULL;
293
294   *dict = dict_create ();
295   if (!fh_open (fh, FH_REF_FILE, "system file", "rs"))
296     goto error;
297
298   /* Create and initialize reader. */
299   r = xmalloc (sizeof *r);
300   r->fh = fh;
301   r->file = fn_open (fh_get_file_name (fh), "rb");
302
303   r->reverse_endian = 0;
304   r->value_cnt = 0;
305   r->case_cnt = 0;
306   r->compressed = 0;
307   r->bias = 100.0;
308   r->weight_idx = -1;
309   r->ok = true;
310   r->has_vls = false;
311
312   r->vars = NULL;
313
314   r->sysmis = -FLT64_MAX;
315   r->highest = FLT64_MAX;
316   r->lowest = second_lowest_flt64;
317
318   r->buf = r->ptr = r->end = NULL;
319   r->y = r->x + sizeof r->x;
320
321   /* Check that file open succeeded. */
322   if (r->file == NULL)
323     {
324       msg (ME, _("An error occurred while opening \"%s\" for reading "
325                  "as a system file: %s."),
326            fh_get_file_name (r->fh), strerror (errno));
327       goto error;
328     }
329
330   /* Read header and variables. */
331   if (!read_header (r, *dict, info) || !read_variables (r, *dict, &var_by_idx))
332     goto error;
333
334
335   /* Handle weighting. */
336   if (r->weight_idx != -1)
337     {
338       struct variable *weight_var;
339
340       if (r->weight_idx < 0 || r->weight_idx >= r->value_cnt)
341         lose ((ME, _("%s: Index of weighting variable (%d) is not between 0 "
342                      "and number of elements per case (%d)."),
343                fh_get_file_name (r->fh), r->weight_idx, r->value_cnt));
344
345
346       weight_var = var_by_idx[r->weight_idx];
347
348       if (weight_var == NULL)
349         lose ((ME,
350                _("%s: Weighting variable may not be a continuation of "
351                  "a long string variable."), fh_get_file_name (fh)));
352       else if (var_is_alpha (weight_var))
353         lose ((ME, _("%s: Weighting variable may not be a string variable."),
354                fh_get_file_name (fh)));
355
356       dict_set_weight (*dict, weight_var);
357     }
358   else
359     dict_set_weight (*dict, NULL);
360
361   /* Read records of types 3, 4, 6, and 7. */
362   for (;;)
363     {
364       int32_t rec_type;
365
366       assertive_buf_read (r, &rec_type, sizeof rec_type, 0);
367       if (r->reverse_endian)
368         bswap_int32 (&rec_type);
369
370
371       switch (rec_type)
372         {
373         case 3:
374           if (!read_value_labels (r, *dict, var_by_idx))
375             goto error;
376           break;
377
378         case 4:
379           lose ((ME, _("%s: Orphaned variable index record (type 4).  Type 4 "
380                        "records must always immediately follow type 3 "
381                        "records."),
382                  fh_get_file_name (r->fh)));
383
384         case 6:
385           if (!read_documents (r, *dict))
386             goto error;
387           break;
388
389         case 7:
390           {
391             struct
392             {
393               int32_t subtype ;
394               int32_t size ;
395               int32_t count ;
396             } ATTRIBUTE((packed)) 
397             data;
398             unsigned long bytes;
399
400             int skip = 0;
401
402             assertive_buf_read (r, &data, sizeof data, 0);
403             if (r->reverse_endian)
404               {
405                 bswap_int32 (&data.subtype);
406                 bswap_int32 (&data.size);
407                 bswap_int32 (&data.count);
408               }
409             bytes = data.size * data.count;
410
411             if (bytes < data.size || bytes < data.count)
412               lose ((ME, "%s: Record type %d subtype %d too large.",
413                      fh_get_file_name (r->fh), rec_type, data.subtype));
414
415             switch (data.subtype)
416               {
417               case 3:
418                 if (!read_machine_int32_info (r, data.size, data.count))
419                   goto error;
420                 break;
421
422               case 4:
423                 if (!read_machine_flt64_info (r, data.size, data.count))
424                   goto error;
425                 break;
426
427               case 5:
428               case 6:  /* ?? Used by SPSS 8.0. */
429                 skip = 1;
430                 break;
431                 
432               case 11: /* Variable display parameters */
433                 {
434                   const int  n_vars = data.count / 3 ;
435                   int i;
436                   if ( data.count % 3 || n_vars != dict_get_var_cnt(*dict) ) 
437                     {
438                       msg (MW, _("%s: Invalid subrecord length. "
439                                  "Record: 7; Subrecord: 11"), 
440                            fh_get_file_name (r->fh));
441                       skip = 1;
442                       break;
443                     }
444
445                   for ( i = 0 ; i < MIN(n_vars, dict_get_var_cnt(*dict)) ; ++i ) 
446                     {
447                       struct
448                       {
449                         int32_t measure ;
450                         int32_t width ;
451                         int32_t align ;
452                       } ATTRIBUTE((packed))
453                       params;
454
455                       struct variable *v;
456
457                       assertive_buf_read (r, &params, sizeof(params), 0);
458
459                       if ( ! measure_is_valid(params.measure) 
460                            || 
461                            ! alignment_is_valid(params.align))
462                         {
463                           msg(MW, 
464                               _("%s: Invalid variable display parameters.  Default parameters substituted."), 
465                               fh_get_file_name(r->fh));
466                           continue;
467                         }
468
469                       v = dict_get_var(*dict, i);
470
471                       var_set_measure (v, params.measure);
472                       var_set_display_width (v, params.width);
473                       var_set_alignment (v, params.align);
474                     }
475                 }
476                 break;
477
478               case 13: /* SPSS 12.0 Long variable name map */
479                 {
480                   char *short_name; 
481                   char *save_ptr = NULL;
482                   int idx;
483
484                   /* Read data. */
485                   subrec14data = xmalloc (bytes + 1);
486                   if (!buf_read (r, subrec14data, bytes, 0)) 
487                     {
488                       goto error;
489                     }
490                   subrec14data[bytes] = '\0';
491
492                   short_to_long = hsh_create(4, 
493                                              pair_sn_compare,
494                                              pair_sn_hash,
495                                              pair_sn_free, 
496                                              0);
497
498                   /* Parse data. */
499                   for (short_name = strtok_r (subrec14data, "=", &save_ptr), idx = 0;
500                        short_name != NULL;
501                        short_name = strtok_r (NULL, "=", &save_ptr), idx++)
502                     {
503                       struct name_pair *pair ;
504                       char *long_name = strtok_r (NULL, "\t", &save_ptr);
505                       struct variable *v;
506
507                       /* Validate long name. */
508                       if (long_name == NULL)
509                         {
510                           msg (MW, _("%s: Trailing garbage in long variable "
511                                      "name map."),
512                                fh_get_file_name (r->fh));
513                           break;
514                         }
515                       if (!var_is_valid_name (long_name, false))
516                         {
517                           msg (MW, _("%s: Long variable mapping to invalid "
518                                      "variable name `%s'."),
519                                fh_get_file_name (r->fh), long_name);
520                           break;
521                         }
522                       
523                       /* Find variable using short name. */
524                       v = dict_lookup_var (*dict, short_name);
525                       if (v == NULL)
526                         {
527                           msg (MW, _("%s: Long variable mapping for "
528                                      "nonexistent variable %s."),
529                                fh_get_file_name (r->fh), short_name);
530                           break;
531                         }
532
533                       /* Identify any duplicates. */
534                       if ( strcasecmp (short_name, long_name) &&
535                            NULL != dict_lookup_var (*dict, long_name))
536                         lose ((ME, _("%s: Duplicate long variable name `%s' "
537                                      "within system file."),
538                                fh_get_file_name (r->fh), long_name));
539
540
541                       /* Set long name.
542                          Renaming a variable may clear the short
543                          name, but we want to retain it, so
544                          re-set it explicitly. */
545                       dict_rename_var (*dict, v, long_name);
546                       var_set_short_name (v, short_name);
547
548                       pair = xmalloc(sizeof *pair);
549                       pair->shortname = short_name;
550                       pair->longname = long_name;
551                       hsh_insert(short_to_long, pair);
552 #if 0 
553       /* This messes up the processing of subtype 14 (below).
554          I'm not sure if it is needed anyway, so I'm removing it for
555          now.  If it's needed, then it will need to be done after all the
556          records have been processed. --- JMD 27 April 2006
557       */
558                       
559                       /* For compatibility, make sure dictionary
560                          is in long variable name map order.  In
561                          the common case, this has no effect,
562                          because the dictionary and the long
563                          variable name map are already in the
564                          same order. */
565                       dict_reorder_var (*dict, v, idx);
566 #endif
567                     }
568                   
569                 }
570                 break;
571
572               case 14:
573                 {
574                   int j = 0;
575                   bool eq_seen = false;
576                   int i;
577
578                   /* Read data. */
579                   char *buffer = xmalloc (bytes + 1);
580                   if (!buf_read (r, buffer, bytes, 0)) 
581                     {
582                       free (buffer);
583                       goto error;
584                     }
585                   buffer[bytes] = '\0';
586
587                   r->has_vls = true;
588
589                   /* Note:  SPSS v13 terminates this record with 00,
590                      whereas SPSS v14 terminates it with 00 09. We must
591                      accept either */ 
592                   for(i = 0; i < bytes ; ++i)
593                     {
594                       long int length;
595                       static char name[SHORT_NAME_LEN + 1]  = {0};
596                       static char len_str[6]  ={0};
597
598                       switch( buffer[i] )
599                         {
600                         case '=':
601                           eq_seen = true;
602                           j = 0;
603                           break;
604                         case '\0':
605                           length = strtol(len_str, 0, 10);
606                           if ( length != LONG_MAX && length != LONG_MIN) 
607                             {
608                               char *lookup_name = name;
609                               int l;
610                               int idx;
611                               struct variable *v;
612
613                               if ( short_to_long ) 
614                                 {
615                                   struct name_pair pair;
616                                   struct name_pair *p;
617
618                                   pair.shortname = name;
619                                   p = hsh_find(short_to_long, &pair);
620                                   if ( p ) 
621                                     lookup_name = p->longname;
622                                 }
623                                 
624                               v = dict_lookup_var(*dict, lookup_name);
625                               if ( !v ) 
626                                 {
627                                   corrupt_msg(MW, 
628                                               _("%s: No variable called %s but it is listed in length table."),
629                                               fh_get_file_name (r->fh), lookup_name);
630
631                                   goto error;
632
633                                 }
634
635                               l = length;
636                               if ( var_get_width (v) > EFFECTIVE_LONG_STRING_LENGTH ) 
637                                 l -= EFFECTIVE_LONG_STRING_LENGTH;
638                               else
639                                 l -= var_get_width (v);
640
641                               idx = var_get_dict_index (v);
642                               while ( l > 0 ) 
643                                 {
644                                   struct variable *v_next;
645                                   v_next = dict_get_var(*dict, idx + 1);
646
647                                   if ( var_get_width (v_next) > EFFECTIVE_LONG_STRING_LENGTH ) 
648                                     l -= EFFECTIVE_LONG_STRING_LENGTH;
649                                   else
650                                     l -= var_get_width (v_next);
651
652                                   dict_delete_var(*dict, v_next);
653                                 }
654
655                               assert ( length >= MIN_VERY_LONG_STRING );
656
657                               var_set_width (v, length);
658                             }
659                           eq_seen = false;
660                           memset(name, 0, SHORT_NAME_LEN+1); 
661                           memset(len_str, 0, 6); 
662                           j = 0;
663                           break;
664                         case '\t':
665                           break;
666                         default:
667                           if ( eq_seen ) 
668                             len_str[j] = buffer[i];
669                           else
670                             name[j] = buffer[i];
671                           j++;
672                           break;
673                         }
674                     }
675                   free(buffer);
676                   dict_compact_values(*dict);
677                 }
678                 break;
679
680               default:
681                 msg (MW, _("%s: Unrecognized record type 7, subtype %d "
682                            "encountered in system file."),
683                      fh_get_file_name (r->fh), data.subtype);
684                 skip = 1;
685               }
686
687             if (skip)
688               {
689                 void *x = buf_read (r, NULL, data.size * data.count, 0);
690                 if (x == NULL)
691                   goto error;
692                 free (x);
693               }
694           }
695           break;
696
697         case 999:
698           {
699             int32_t filler;
700
701             assertive_buf_read (r, &filler, sizeof filler, 0);
702
703             goto success;
704           }
705
706         default:
707           corrupt_msg(MW, _("%s: Unrecognized record type %d."),
708                       fh_get_file_name (r->fh), rec_type);
709         }
710     }
711
712  success:
713   /* Come here on successful completion. */
714
715   /* Create an index of dictionary variable widths for
716      sfm_read_case to use.  We cannot use the `struct variables'
717      from the dictionary we created, because the caller owns the
718      dictionary and may destroy or modify its variables. */
719   {
720     size_t i;
721
722     r->var_cnt = dict_get_var_cnt (*dict);
723     r->vars = xnmalloc (r->var_cnt, sizeof *r->vars);
724     for (i = 0; i < r->var_cnt; i++) 
725       {
726         struct variable *v = dict_get_var (*dict, i);
727         struct sfm_var *sv = &r->vars[i];
728         sv->width = var_get_width (v);
729         sv->fv = var_get_case_index (v); 
730       }
731   }
732
733   free (var_by_idx);
734   hsh_destroy(short_to_long);
735   free (subrec14data);
736   return r;
737
738  error:
739   /* Come here on unsuccessful completion. */
740   sfm_close_reader (r);
741   free (var_by_idx);
742   hsh_destroy(short_to_long);
743   free (subrec14data);
744   if (*dict != NULL) 
745     {
746       dict_destroy (*dict);
747       *dict = NULL; 
748     }
749   return NULL;
750 }
751
752 /* Read record type 7, subtype 3. */
753 static int
754 read_machine_int32_info (struct sfm_reader *r, int size, int count)
755 {
756   int32_t data[8];
757   int file_bigendian;
758
759   int i;
760
761   if (size != sizeof (int32_t) || count != 8)
762     lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
763                  "subtype 3.    Expected size %d, count 8."),
764            fh_get_file_name (r->fh), size, count, sizeof (int32_t)));
765
766   assertive_buf_read (r, data, sizeof data, 0);
767   if (r->reverse_endian)
768     for (i = 0; i < 8; i++)
769       bswap_int32 (&data[i]);
770
771 #ifdef FPREP_IEEE754
772   if (data[4] != 1)
773     lose ((ME, _("%s: Floating-point representation in system file is not "
774                  "IEEE-754.  PSPP cannot convert between floating-point "
775                  "formats."),
776            fh_get_file_name (r->fh)));
777 #else
778 #error Add support for your floating-point format.
779 #endif
780
781 #ifdef WORDS_BIGENDIAN
782   file_bigendian = 1;
783 #else
784   file_bigendian = 0;
785 #endif
786   if (r->reverse_endian)
787     file_bigendian ^= 1;
788   if (file_bigendian ^ (data[6] == 1))
789     lose ((ME, _("%s: File-indicated endianness (%s) does not match "
790                  "endianness intuited from file header (%s)."),
791            fh_get_file_name (r->fh),
792            file_bigendian ? _("big-endian") : _("little-endian"),
793            data[6] == 1 ? _("big-endian") : (data[6] == 2 ? _("little-endian")
794                                              : _("unknown"))));
795
796   /* PORTME: Character representation code. */
797   if (data[7] != 2 && data[7] != 3) 
798     lose ((ME, _("%s: File-indicated character representation code (%s) is "
799                  "not ASCII."),
800            fh_get_file_name (r->fh),
801            (data[7] == 1 ? "EBCDIC"
802             : (data[7] == 4 ? _("DEC Kanji") : _("Unknown")))));
803
804   return 1;
805
806  error:
807   return 0;
808 }
809
810 /* Read record type 7, subtype 4. */
811 static int
812 read_machine_flt64_info (struct sfm_reader *r, int size, int count)
813 {
814   flt64 data[3];
815   int i;
816
817   if (size != sizeof (flt64) || count != 3)
818     lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
819                  "subtype 4.    Expected size %d, count 8."),
820            fh_get_file_name (r->fh), size, count, sizeof (flt64)));
821
822   assertive_buf_read (r, data, sizeof data, 0);
823   if (r->reverse_endian)
824     for (i = 0; i < 3; i++)
825       bswap_flt64 (&data[i]);
826
827   if (data[0] != SYSMIS || data[1] != FLT64_MAX
828       || data[2] != second_lowest_flt64)
829     {
830       r->sysmis = data[0];
831       r->highest = data[1];
832       r->lowest = data[2];
833       msg (MW, _("%s: File-indicated value is different from internal value "
834                  "for at least one of the three system values.  SYSMIS: "
835                  "indicated %g, expected %g; HIGHEST: %g, %g; LOWEST: "
836                  "%g, %g."),
837            fh_get_file_name (r->fh), (double) data[0], (double) SYSMIS,
838            (double) data[1], (double) FLT64_MAX,
839            (double) data[2], (double) second_lowest_flt64);
840     }
841   
842   return 1;
843
844  error:
845   return 0;
846 }
847
848 static int
849 read_header (struct sfm_reader *r,
850              struct dictionary *dict, struct sfm_read_info *info)
851 {
852   struct sysfile_header hdr;            /* Disk buffer. */
853   char prod_name[sizeof hdr.prod_name + 1];     /* Buffer for product name. */
854   int skip_amt = 0;                     /* Amount of product name to omit. */
855   int i;
856
857   /* Read header, check magic. */
858   assertive_buf_read (r, &hdr, sizeof hdr, 0);
859   if (strncmp ("$FL2", hdr.rec_type, 4) != 0)
860     lose ((ME, _("%s: Bad magic.  Proper system files begin with "
861                  "the four characters `$FL2'. This file will not be read."),
862            fh_get_file_name (r->fh)));
863
864   /* Check eye-category.her string. */
865   memcpy (prod_name, hdr.prod_name, sizeof hdr.prod_name);
866   for (i = 0; i < 60; i++)
867     if (!c_isprint ((unsigned char) prod_name[i]))
868       prod_name[i] = ' ';
869   for (i = 59; i >= 0; i--)
870     if (!c_isgraph ((unsigned char) prod_name[i]))
871       {
872         prod_name[i] = '\0';
873         break;
874       }
875   prod_name[60] = '\0';
876   
877   {
878 #define N_PREFIXES 2
879     static const char *prefix[N_PREFIXES] =
880       {
881         "@(#) SPSS DATA FILE",
882         "SPSS SYSTEM FILE.",
883       };
884
885     int i;
886
887     for (i = 0; i < N_PREFIXES; i++)
888       if (!strncmp (prefix[i], hdr.prod_name, strlen (prefix[i])))
889         {
890           skip_amt = strlen (prefix[i]);
891           break;
892         }
893   }
894   
895   /* Check endianness. */
896   if (hdr.layout_code == 2)
897     r->reverse_endian = 0;
898   else
899     {
900       bswap_int32 (&hdr.layout_code);
901       if (hdr.layout_code != 2)
902         lose ((ME, _("%s: File layout code has unexpected value %d.  Value "
903                      "should be 2, in big-endian or little-endian format."),
904                fh_get_file_name (r->fh), hdr.layout_code));
905
906       r->reverse_endian = 1;
907       bswap_int32 (&hdr.nominal_case_size);
908       bswap_int32 (&hdr.compress);
909       bswap_int32 (&hdr.weight_idx);
910       bswap_int32 (&hdr.case_cnt);
911       bswap_flt64 (&hdr.bias);
912     }
913
914
915   /* Copy basic info and verify correctness. */
916   r->value_cnt = hdr.nominal_case_size;
917
918   /* If value count is ridiculous, then force it to -1 (a
919      sentinel value). */
920   if ( r->value_cnt < 0 || 
921        r->value_cnt > (INT_MAX / (int) sizeof (union value) / 2))
922     r->value_cnt = -1;
923
924   r->compressed = hdr.compress;
925
926   r->weight_idx = hdr.weight_idx - 1;
927
928   r->case_cnt = hdr.case_cnt;
929   if (r->case_cnt < -1 || r->case_cnt > INT_MAX / 2)
930     lose ((ME,
931            _("%s: Number of cases in file (%ld) is not between -1 and %d."),
932            fh_get_file_name (r->fh), (long) r->case_cnt, INT_MAX / 2));
933
934   r->bias = hdr.bias;
935   if (r->bias != 100.0)
936     corrupt_msg (MW, _("%s: Compression bias (%g) is not the usual "
937                        "value of 100."),
938                  fh_get_file_name (r->fh), r->bias);
939
940   /* Make a file label only on the condition that the given label is
941      not all spaces or nulls. */
942   {
943     int i;
944
945     for (i = sizeof hdr.file_label - 1; i >= 0; i--)
946       {
947         if (!c_isspace ((unsigned char) hdr.file_label[i])
948             && hdr.file_label[i] != 0)
949           {
950             char *label = xmalloc (i + 2);
951             memcpy (label, hdr.file_label, i + 1);
952             label[i + 1] = 0;
953             dict_set_label (dict, label);
954             free (label);
955             break;
956           }
957       }
958   }
959
960   if (info)
961     {
962       char *cp;
963
964       memcpy (info->creation_date, hdr.creation_date, 9);
965       info->creation_date[9] = 0;
966
967       memcpy (info->creation_time, hdr.creation_time, 8);
968       info->creation_time[8] = 0;
969
970 #ifdef WORDS_BIGENDIAN
971       info->big_endian = !r->reverse_endian;
972 #else
973       info->big_endian = r->reverse_endian;
974 #endif
975
976       info->compressed = hdr.compress;
977
978       info->case_cnt = hdr.case_cnt;
979
980       for (cp = &prod_name[skip_amt]; cp < &prod_name[60]; cp++)
981         if (c_isgraph ((unsigned char) *cp))
982           break;
983       strcpy (info->product, cp);
984     }
985
986   return 1;
987
988  error:
989   return 0;
990 }
991
992 /* Reads most of the dictionary from file H; also fills in the
993    associated VAR_BY_IDX array. */
994 static int
995 read_variables (struct sfm_reader *r,
996                 struct dictionary *dict, struct variable ***var_by_idx)
997 {
998   int i;
999
1000   struct sysfile_variable sv;           /* Disk buffer. */
1001   int long_string_count = 0;    /* # of long string continuation
1002                                    records still expected. */
1003   int next_value = 0;           /* Index to next `value' structure. */
1004
1005   assert(r);
1006
1007   *var_by_idx = 0;
1008
1009
1010   /* Read in the entry for each variable and use the info to
1011      initialize the dictionary. */
1012   for (i = 0; ; ++i)
1013     {
1014       struct variable *vv;
1015       char name[SHORT_NAME_LEN + 1];
1016       int nv;
1017       int j;
1018       struct fmt_spec print, write;
1019
1020
1021       assertive_buf_read (r, &sv, sizeof sv, 0);
1022
1023       if (r->reverse_endian)
1024         {
1025           bswap_int32 (&sv.rec_type);
1026           bswap_int32 (&sv.type);
1027           bswap_int32 (&sv.has_var_label);
1028           bswap_int32 (&sv.n_missing_values);
1029           bswap_int32 (&sv.print);
1030           bswap_int32 (&sv.write);
1031         }
1032
1033       /* We've come to the end of the variable entries */
1034       if (sv.rec_type != 2)
1035         {
1036           buf_unread(r, sizeof sv);
1037           r->value_cnt = i;
1038           break;
1039         }
1040
1041       *var_by_idx = xnrealloc (*var_by_idx, i + 1, sizeof **var_by_idx);
1042
1043       /* If there was a long string previously, make sure that the
1044          continuations are present; otherwise make sure there aren't
1045          any. */
1046       if (long_string_count)
1047         {
1048           if (sv.type != -1)
1049             lose ((ME, _("%s: position %d: String variable does not have "
1050                          "proper number of continuation records."),
1051                    fh_get_file_name (r->fh), i));
1052
1053
1054           (*var_by_idx)[i] = NULL;
1055           long_string_count--;
1056           continue;
1057         }
1058       else if (sv.type == -1)
1059         lose ((ME, _("%s: position %d: Superfluous long string continuation "
1060                      "record."),
1061                fh_get_file_name (r->fh), i));
1062
1063       /* Check fields for validity. */
1064       if (sv.type < 0 || sv.type > 255)
1065         lose ((ME, _("%s: position %d: Bad variable type code %d."),
1066                fh_get_file_name (r->fh), i, sv.type));
1067       if (sv.has_var_label != 0 && sv.has_var_label != 1)
1068         lose ((ME, _("%s: position %d: Variable label indicator field is not "
1069                      "0 or 1."), fh_get_file_name (r->fh), i));
1070       if (sv.n_missing_values < -3 || sv.n_missing_values > 3
1071           || sv.n_missing_values == -1)
1072         lose ((ME, _("%s: position %d: Missing value indicator field is not "
1073                      "-3, -2, 0, 1, 2, or 3."), fh_get_file_name (r->fh), i));
1074
1075       /* Copy first character of variable name. */
1076       if (sv.name[0] == '@' || sv.name[0] == '#')
1077         lose ((ME, _("%s: position %d: Variable name begins with invalid "
1078                      "character."),
1079                fh_get_file_name (r->fh), i));
1080
1081       name[0] = sv.name[0];
1082
1083       /* Copy remaining characters of variable name. */
1084       for (j = 1; j < SHORT_NAME_LEN; j++)
1085         {
1086           int c = (unsigned char) sv.name[j];
1087
1088           if (c == ' ') 
1089             break;
1090           else 
1091             name[j] = c;
1092         }
1093       name[j] = 0;
1094
1095       if ( ! var_is_plausible_name(name, false) ) 
1096         lose ((ME, _("%s: Invalid variable name `%s' within system file."),
1097                fh_get_file_name (r->fh), name));
1098
1099       /* Create variable. */
1100       vv = (*var_by_idx)[i] = dict_create_var (dict, name, sv.type);
1101       if (vv == NULL) 
1102         lose ((ME, _("%s: Duplicate variable name `%s' within system file."),
1103                fh_get_file_name (r->fh), name));
1104
1105       /* Set the short name the same as the long name */
1106       var_set_short_name (vv, var_get_name (vv));
1107
1108       /* Case reading data. */
1109       nv = sv.type == 0 ? 1 : DIV_RND_UP (sv.type, sizeof (flt64));
1110       long_string_count = nv - 1;
1111       next_value += nv;
1112
1113       /* Get variable label, if any. */
1114       if (sv.has_var_label == 1)
1115         {
1116           /* Disk buffer. */
1117           int32_t len;
1118
1119           /* Read length of label. */
1120           assertive_buf_read (r, &len, sizeof len, 0);
1121           if (r->reverse_endian)
1122             bswap_int32 (&len);
1123
1124           /* Check len. */
1125           if (len < 0 || len > 255)
1126             lose ((ME, _("%s: Variable %s indicates variable label of invalid "
1127                          "length %d."),
1128                    fh_get_file_name (r->fh), var_get_name (vv), len));
1129
1130           if ( len != 0 ) 
1131             {
1132               /* Read label into variable structure. */
1133               char label[256];
1134               assertive_buf_read (r, label, ROUND_UP (len, sizeof (int32_t)),
1135                                   0);
1136               label[len] = '\0';
1137               var_set_label (vv, label);
1138             }
1139         }
1140
1141       /* Set missing values. */
1142       if (sv.n_missing_values != 0)
1143         {
1144           flt64 mv[3];
1145           int mv_cnt = abs (sv.n_missing_values);
1146           struct missing_values miss;
1147
1148           if (var_get_width (vv) > MAX_SHORT_STRING)
1149             lose ((ME, _("%s: Long string variable %s may not have missing "
1150                          "values."),
1151                    fh_get_file_name (r->fh), var_get_name (vv)));
1152           mv_init (&miss, var_get_width (vv));
1153
1154           assertive_buf_read (r, mv, sizeof *mv * mv_cnt, 0);
1155
1156           if (r->reverse_endian && var_is_numeric (vv))
1157             for (j = 0; j < mv_cnt; j++)
1158               bswap_flt64 (&mv[j]);
1159
1160           if (sv.n_missing_values > 0)
1161             {
1162               for (j = 0; j < sv.n_missing_values; j++)
1163                 if (var_is_numeric (vv))
1164                   mv_add_num (&miss, mv[j]);
1165                 else
1166                   mv_add_str (&miss, (char *) &mv[j]);
1167             }
1168           else
1169             {
1170               if (var_is_alpha (vv))
1171                 lose ((ME, _("%s: String variable %s may not have missing "
1172                              "values specified as a range."),
1173                        fh_get_file_name (r->fh), var_get_name (vv)));
1174
1175               if (mv[0] == r->lowest)
1176                 mv_add_num_range (&miss, LOWEST, mv[1]);
1177               else if (mv[1] == r->highest)
1178                 mv_add_num_range (&miss, mv[0], HIGHEST);
1179               else
1180                 mv_add_num_range (&miss, mv[0], mv[1]);
1181
1182               if (sv.n_missing_values == -3)
1183                 mv_add_num (&miss, mv[2]);
1184             }
1185           var_set_missing_values (vv, &miss);
1186         }
1187
1188       if (!parse_format_spec (r, sv.print, &print, vv)
1189           || !parse_format_spec (r, sv.write, &write, vv))
1190         goto error;
1191
1192       var_set_print_format (vv, &print);
1193       var_set_write_format (vv, &write);
1194     }
1195
1196   /* Some consistency checks. */
1197   if (long_string_count != 0)
1198     lose ((ME, _("%s: Long string continuation records omitted at end of "
1199                  "dictionary."),
1200            fh_get_file_name (r->fh)));
1201
1202   if (next_value != r->value_cnt)
1203     corrupt_msg(MW, _("%s: System file header indicates %d variable positions but "
1204                       "%d were read from file."),
1205                 fh_get_file_name (r->fh), r->value_cnt, next_value);
1206
1207
1208   return 1;
1209
1210  error:
1211   return 0;
1212 }
1213
1214 /* Translates the format spec from sysfile format to internal
1215    format. */
1216 static int
1217 parse_format_spec (struct sfm_reader *r, int32_t s,
1218                    struct fmt_spec *f, const struct variable *v)
1219 {
1220   bool ok;
1221   
1222   if (!fmt_from_io ((s >> 16) & 0xff, &f->type))
1223     lose ((ME, _("%s: Bad format specifier byte (%d)."),
1224            fh_get_file_name (r->fh), (s >> 16) & 0xff));
1225   f->w = (s >> 8) & 0xff;
1226   f->d = s & 0xff;
1227
1228   if (var_is_alpha (v) != fmt_is_string (f->type))
1229     lose ((ME, _("%s: %s variable %s has %s format specifier %s."),
1230            fh_get_file_name (r->fh),
1231            var_is_alpha (v) ? _("String") : _("Numeric"),
1232            var_get_name (v),
1233            fmt_is_string (f->type) ? _("string") : _("numeric"),
1234            fmt_name (f->type)));
1235
1236   msg_disable ();
1237   ok = fmt_check_output (f) && fmt_check_width_compat (f, var_get_width (v)); 
1238   msg_enable ();
1239   
1240   if (!ok) 
1241     {
1242       char fmt_string[FMT_STRING_LEN_MAX + 1];
1243       msg (ME, _("%s variable %s has invalid format specifier %s."),
1244            var_is_numeric (v) ? _("Numeric") : _("String"),
1245            var_get_name (v), fmt_to_string (f, fmt_string));
1246       *f = (var_is_numeric (v)
1247             ? fmt_for_output (FMT_F, 8, 2) 
1248             : fmt_for_output (FMT_A, var_get_width (v), 0));
1249     }
1250   return 1;
1251
1252  error:
1253   return 0;
1254 }
1255
1256 /* Reads value labels from sysfile H and inserts them into the
1257    associated dictionary. */
1258 int
1259 read_value_labels (struct sfm_reader *r,
1260                    struct dictionary *dict, struct variable **var_by_idx)
1261 {
1262   struct label 
1263   {
1264     char raw_value[8];        /* Value as uninterpreted bytes. */
1265     union value value;        /* Value. */
1266     char *label;              /* Null-terminated label string. */
1267   };
1268
1269   struct label *labels = NULL;
1270   int32_t n_labels;             /* Number of labels. */
1271
1272   struct variable **var = NULL; /* Associated variables. */
1273   int32_t n_vars;                       /* Number of associated variables. */
1274
1275   int i;
1276
1277   /* First step: read the contents of the type 3 record and record its
1278      contents.  Note that we can't do much with the data since we
1279      don't know yet whether it is of numeric or string type. */
1280
1281   /* Read number of labels. */
1282   assertive_buf_read (r, &n_labels, sizeof n_labels, 0);
1283   if (r->reverse_endian)
1284     bswap_int32 (&n_labels);
1285
1286   if ( n_labels >= ((int32_t) ~0) / sizeof *labels)
1287     {    
1288       corrupt_msg(MW, _("%s: Invalid number of labels: %d.  Ignoring labels."),
1289                   fh_get_file_name (r->fh), n_labels);
1290       n_labels = 0;
1291     }
1292
1293   /* Allocate memory. */
1294   labels = xcalloc (n_labels, sizeof *labels);
1295   for (i = 0; i < n_labels; i++)
1296     labels[i].label = NULL;
1297
1298   /* Read each value/label tuple into labels[]. */
1299   for (i = 0; i < n_labels; i++)
1300     {
1301       struct label *label = labels + i;
1302       unsigned char label_len;
1303       size_t padded_len;
1304
1305       /* Read value. */
1306       assertive_buf_read (r, label->raw_value, sizeof label->raw_value, 0);
1307
1308       /* Read label length. */
1309       assertive_buf_read (r, &label_len, sizeof label_len, 0);
1310       padded_len = ROUND_UP (label_len + 1, sizeof (flt64));
1311
1312       /* Read label, padding. */
1313       label->label = xmalloc (padded_len + 1);
1314       assertive_buf_read (r, label->label, padded_len - 1, 0);
1315       label->label[label_len] = 0;
1316     }
1317
1318   /* Second step: Read the type 4 record that has the list of
1319      variables to which the value labels are to be applied. */
1320
1321   /* Read record type of type 4 record. */
1322   {
1323     int32_t rec_type;
1324     
1325     assertive_buf_read (r, &rec_type, sizeof rec_type, 0);
1326     if (r->reverse_endian)
1327       bswap_int32 (&rec_type);
1328     
1329     if (rec_type != 4)
1330       lose ((ME, _("%s: Variable index record (type 4) does not immediately "
1331                    "follow value label record (type 3) as it should."),
1332              fh_get_file_name (r->fh)));
1333   }
1334
1335   /* Read number of variables associated with value label from type 4
1336      record. */
1337   assertive_buf_read (r, &n_vars, sizeof n_vars, 0);
1338   if (r->reverse_endian)
1339     bswap_int32 (&n_vars);
1340   if (n_vars < 1 || n_vars > dict_get_var_cnt (dict))
1341     lose ((ME, _("%s: Number of variables associated with a value label (%d) "
1342                  "is not between 1 and the number of variables (%d)."),
1343            fh_get_file_name (r->fh), n_vars, dict_get_var_cnt (dict)));
1344
1345   /* Read the list of variables. */
1346   var = xnmalloc (n_vars, sizeof *var);
1347   for (i = 0; i < n_vars; i++)
1348     {
1349       int32_t var_idx;
1350       struct variable *v;
1351
1352       /* Read variable index, check range. */
1353       assertive_buf_read (r, &var_idx, sizeof var_idx, 0);
1354       if (r->reverse_endian)
1355         bswap_int32 (&var_idx);
1356       if (var_idx < 1 || var_idx > r->value_cnt)
1357         lose ((ME, _("%s: Variable index associated with value label (%d) is "
1358                      "not between 1 and the number of values (%d)."),
1359                fh_get_file_name (r->fh), var_idx, r->value_cnt));
1360
1361       /* Make sure it's a real variable. */
1362       v = var_by_idx[var_idx - 1];
1363       if (v == NULL)
1364         lose ((ME, _("%s: Variable index associated with value label (%d) "
1365                      "refers to a continuation of a string variable, not to "
1366                      "an actual variable."),
1367                fh_get_file_name (r->fh), var_idx));
1368       if (var_is_long_string (v))
1369         lose ((ME, _("%s: Value labels are not allowed on long string "
1370                      "variables (%s)."),
1371                fh_get_file_name (r->fh), var_get_name (v)));
1372
1373       /* Add it to the list of variables. */
1374       var[i] = v;
1375     }
1376
1377   /* Type check the variables. */
1378   for (i = 1; i < n_vars; i++)
1379     if (var_get_type (var[i]) != var_get_type (var[0]))
1380       lose ((ME, _("%s: Variables associated with value label are not all of "
1381                    "identical type.  Variable %s has %s type, but variable "
1382                    "%s has %s type."),
1383              fh_get_file_name (r->fh),
1384              var_get_name (var[0]),
1385              var_is_alpha (var[0]) ? _("string") : _("numeric"),
1386              var_get_name (var[i]),
1387              var_is_alpha (var[i]) ? _("string") : _("numeric")));
1388
1389   /* Fill in labels[].value, now that we know the desired type. */
1390   for (i = 0; i < n_labels; i++) 
1391     {
1392       struct label *label = labels + i;
1393       
1394       if (var_is_alpha (var[0]))
1395         {
1396           const int copy_len = MIN (sizeof label->raw_value,
1397                                     sizeof label->label);
1398           memcpy (label->value.s, label->raw_value, copy_len);
1399         } else {
1400           flt64 f;
1401           assert (sizeof f == sizeof label->raw_value);
1402           memcpy (&f, label->raw_value, sizeof f);
1403           if (r->reverse_endian)
1404             bswap_flt64 (&f);
1405           label->value.f = f;
1406         }
1407     }
1408   
1409   /* Assign the value_label's to each variable. */
1410   for (i = 0; i < n_vars; i++)
1411     {
1412       struct variable *v = var[i];
1413       int j;
1414
1415       /* Add each label to the variable. */
1416       for (j = 0; j < n_labels; j++)
1417         {
1418           struct label *label = labels + j;
1419           if (var_add_value_label (v, &label->value, label->label))
1420             continue;
1421
1422           if (var_is_numeric (var[0]))
1423             msg (MW, _("%s: File contains duplicate label for value %g for "
1424                        "variable %s."),
1425                  fh_get_file_name (r->fh), label->value.f, var_get_name (v));
1426           else
1427             msg (MW, _("%s: File contains duplicate label for value `%.*s' "
1428                        "for variable %s."),
1429                  fh_get_file_name (r->fh), var_get_width (v),
1430                  label->value.s, var_get_name (v));
1431         }
1432     }
1433
1434   for (i = 0; i < n_labels; i++)
1435     free (labels[i].label);
1436   free (labels);
1437   free (var);
1438   return 1;
1439
1440  error:
1441   if (labels) 
1442     {
1443       for (i = 0; i < n_labels; i++)
1444         free (labels[i].label);
1445       free (labels); 
1446     }
1447   free (var);
1448   return 0;
1449 }
1450
1451 /* Reads BYTE_CNT bytes from the file represented by H.  If BUF is
1452    non-NULL, uses that as the buffer; otherwise allocates at least
1453    MIN_ALLOC bytes.  Returns a pointer to the buffer on success, NULL
1454    on failure. */
1455 static void *
1456 buf_read (struct sfm_reader *r, void *buf, size_t byte_cnt, size_t min_alloc)
1457 {
1458   assert (r);
1459
1460   if (buf == NULL && byte_cnt > 0 )
1461     buf = xmalloc (MAX (byte_cnt, min_alloc));
1462
1463   if ( byte_cnt == 0 )
1464     return buf;
1465
1466   
1467   if (1 != fread (buf, byte_cnt, 1, r->file))
1468     {
1469       if (ferror (r->file))
1470         msg (ME, _("%s: Reading system file: %s."),
1471              fh_get_file_name (r->fh), strerror (errno));
1472       else
1473         corrupt_msg (ME, _("%s: Unexpected end of file."),
1474                      fh_get_file_name (r->fh));
1475       r->ok = false;
1476       return NULL;
1477     }
1478
1479   return buf;
1480 }
1481
1482 /* Winds the reader BYTE_CNT bytes back in the reader stream.   */
1483 void
1484 buf_unread(struct sfm_reader *r, size_t byte_cnt)
1485 {
1486   assert(byte_cnt > 0);
1487
1488   if ( 0 != fseek(r->file, -byte_cnt, SEEK_CUR))
1489     {
1490       msg (ME, _("%s: Seeking system file: %s."),
1491            fh_get_file_name (r->fh), strerror (errno));
1492     }
1493 }
1494
1495 /* Reads a document record, type 6, from system file R, and sets up
1496    the documents and n_documents fields in the associated
1497    dictionary. */
1498 static int
1499 read_documents (struct sfm_reader *r, struct dictionary *dict)
1500 {
1501   int32_t line_cnt;
1502   char *documents;
1503
1504   if (dict_get_documents (dict) != NULL)
1505     lose ((ME, _("%s: System file contains multiple "
1506                  "type 6 (document) records."),
1507            fh_get_file_name (r->fh)));
1508
1509   assertive_buf_read (r, &line_cnt, sizeof line_cnt, 0);
1510   if (line_cnt <= 0)
1511     lose ((ME, _("%s: Number of document lines (%ld) "
1512                  "must be greater than 0."),
1513            fh_get_file_name (r->fh), (long) line_cnt));
1514
1515   documents = buf_read (r, NULL, 80 * line_cnt, line_cnt * 80 + 1);
1516   /* FIXME?  Run through asciify. */
1517   if (documents == NULL)
1518     return 0;
1519   documents[80 * line_cnt] = '\0';
1520   dict_set_documents (dict, documents);
1521   free (documents);
1522   return 1;
1523
1524  error:
1525   return 0;
1526 }
1527 \f
1528 /* Data reader. */
1529
1530 /* Reads compressed data into H->BUF and sets other pointers
1531    appropriately.  Returns nonzero only if both no errors occur and
1532    data was read. */
1533 static int
1534 buffer_input (struct sfm_reader *r)
1535 {
1536   size_t amt;
1537
1538   if (!r->ok)
1539     return false;
1540   if (r->buf == NULL)
1541     r->buf = xnmalloc (128, sizeof *r->buf);
1542   amt = fread (r->buf, sizeof *r->buf, 128, r->file);
1543   if (ferror (r->file))
1544     {
1545       msg (ME, _("%s: Error reading file: %s."),
1546            fh_get_file_name (r->fh), strerror (errno));
1547       r->ok = false;
1548       return 0;
1549     }
1550   r->ptr = r->buf;
1551   r->end = &r->buf[amt];
1552   return amt;
1553 }
1554
1555 /* Reads a single case consisting of compressed data from system
1556    file H into the array BUF[] according to reader R, and
1557    returns nonzero only if successful. */
1558 /* Data in system files is compressed in this manner.  Data
1559    values are grouped into sets of eight ("octets").  Each value
1560    in an octet has one instruction byte that are output together.
1561    Each instruction byte gives a value for that byte or indicates
1562    that the value can be found following the instructions. */
1563 static int
1564 read_compressed_data (struct sfm_reader *r, flt64 *buf)
1565 {
1566   const unsigned char *p_end = r->x + sizeof (flt64);
1567   unsigned char *p = r->y;
1568
1569   const flt64 *buf_beg = buf;
1570   const flt64 *buf_end = &buf[r->value_cnt];
1571
1572   for (;;)
1573     {
1574       for (; p < p_end; p++){
1575         switch (*p)
1576           {
1577           case 0:
1578             /* Code 0 is ignored. */
1579             continue;
1580           case 252:
1581             /* Code 252 is end of file. */
1582             if (buf_beg == buf)
1583               return 0;
1584             lose ((ME, _("%s: Compressed data is corrupted.  Data ends "
1585                          "in partial case."),
1586                    fh_get_file_name (r->fh)));
1587           case 253:
1588             /* Code 253 indicates that the value is stored explicitly
1589                following the instruction bytes. */
1590             if (r->ptr == NULL || r->ptr >= r->end)
1591               if (!buffer_input (r))
1592                 lose ((ME, _("%s: Unexpected end of file."),
1593                        fh_get_file_name (r->fh)));
1594             memcpy (buf++, r->ptr++, sizeof *buf);
1595             if (buf >= buf_end)
1596               goto success;
1597             break;
1598           case 254:
1599             /* Code 254 indicates a string that is all blanks. */
1600             memset (buf++, ' ', sizeof *buf);
1601             if (buf >= buf_end)
1602               goto success;
1603             break;
1604           case 255:
1605             /* Code 255 indicates the system-missing value. */
1606             *buf = r->sysmis;
1607             if (r->reverse_endian)
1608               bswap_flt64 (buf);
1609             buf++;
1610             if (buf >= buf_end)
1611               goto success;
1612             break;
1613           default:
1614             /* Codes 1 through 251 inclusive are taken to indicate a
1615                value of (BYTE - BIAS), where BYTE is the byte's value
1616                and BIAS is the compression bias (generally 100.0). */
1617             *buf = *p - r->bias;
1618             if (r->reverse_endian)
1619               bswap_flt64 (buf);
1620             buf++;
1621             if (buf >= buf_end)
1622               goto success;
1623             break;
1624           }
1625       }
1626       /* We have reached the end of this instruction octet.  Read
1627          another. */
1628       if (r->ptr == NULL || r->ptr >= r->end) 
1629         {
1630           if (!buffer_input (r))
1631             {
1632               if (buf_beg != buf)
1633                 lose ((ME, _("%s: Unexpected end of file."),
1634                        fh_get_file_name (r->fh))); 
1635               else
1636                 return 0;
1637             }
1638         }
1639       memcpy (r->x, r->ptr++, sizeof *buf);
1640       p = r->x;
1641     }
1642
1643   NOT_REACHED ();
1644
1645  success:
1646   /* We have filled up an entire record.  Update state and return
1647      successfully. */
1648   r->y = ++p;
1649   return 1;
1650
1651  error:
1652   /* I/O error. */
1653   r->ok = false;
1654   return 0;
1655 }
1656
1657 /* Reads one case from READER's file into C.  Returns nonzero
1658    only if successful. */
1659 int
1660 sfm_read_case (struct sfm_reader *r, struct ccase *c)
1661 {
1662   if (!r->ok)
1663     return 0;
1664
1665   if (!r->compressed && sizeof (flt64) == sizeof (double) && ! r->has_vls) 
1666     {
1667       /* Fast path: external and internal representations are the
1668          same, except possibly for endianness or SYSMIS.  Read
1669          directly into the case's buffer, then fix up any minor
1670          details as needed. */
1671       if (!fread_ok (r, case_data_all_rw (c),
1672                      sizeof (union value) * r->value_cnt))
1673         return 0;
1674
1675       /* Fix up endianness if needed. */
1676       if (r->reverse_endian) 
1677         {
1678           int i;
1679           
1680           for (i = 0; i < r->var_cnt; i++) 
1681             if (r->vars[i].width == 0)
1682               bswap_flt64 (&case_data_rw_idx (c, r->vars[i].fv)->f);
1683         }
1684
1685       /* Fix up SYSMIS values if needed.
1686          I don't think this will ever actually kick in, but it
1687          can't hurt. */
1688       if (r->sysmis != SYSMIS) 
1689         {
1690           int i;
1691           
1692           for (i = 0; i < r->var_cnt; i++) 
1693             if (r->vars[i].width == 0 && case_num_idx (c, i) == r->sysmis)
1694               case_data_rw_idx (c, r->vars[i].fv)->f = SYSMIS;
1695         }
1696     }
1697   else 
1698     {
1699       /* Slow path: internal and external representations differ.
1700          Read into a bounce buffer, then copy to C. */
1701       flt64 *bounce;
1702       flt64 *bounce_cur;
1703       size_t bounce_size;
1704       int read_ok;
1705       int i;
1706
1707       bounce_size = sizeof *bounce * r->value_cnt;
1708       bounce = bounce_cur = local_alloc (bounce_size);
1709
1710       memset(bounce, 0, bounce_size);
1711
1712       if (!r->compressed)
1713         read_ok = fread_ok (r, bounce, bounce_size);
1714       else
1715         read_ok = read_compressed_data (r, bounce);
1716       if (!read_ok) 
1717         {
1718           local_free (bounce);
1719           return 0;
1720         }
1721
1722       for (i = 0; i < r->var_cnt; i++)
1723         {
1724           struct sfm_var *sv = &r->vars[i];
1725
1726           if (sv->width == 0)
1727             {
1728               flt64 f = *bounce_cur++;
1729               if (r->reverse_endian)
1730                 bswap_flt64 (&f);
1731               case_data_rw_idx (c, sv->fv)->f = f == r->sysmis ? SYSMIS : f;
1732             }
1733           else
1734             {
1735               flt64 *bc_start = bounce_cur;
1736               int ofs = 0;
1737               while (ofs < sv->width )
1738                 {
1739                   const int chunk = MIN (MIN_VERY_LONG_STRING - 1,
1740                                          sv->width - ofs);
1741                   memcpy (case_data_rw_idx (c, sv->fv)->s + ofs,
1742                           bounce_cur, chunk);
1743
1744                   bounce_cur += DIV_RND_UP (chunk, sizeof (flt64));
1745
1746                   ofs += chunk;
1747                 }
1748               bounce_cur = bc_start + sfm_width_to_bytes (sv->width) / sizeof(flt64);
1749             }
1750         }
1751
1752       local_free (bounce);
1753     }
1754   return 1; 
1755 }
1756
1757 static int
1758 fread_ok (struct sfm_reader *r, void *buffer, size_t byte_cnt)
1759 {
1760   size_t read_bytes = fread (buffer, 1, byte_cnt, r->file);
1761
1762   if (read_bytes == byte_cnt)
1763     return 1;
1764   else
1765     {
1766       if (ferror (r->file)) 
1767         {
1768           msg (ME, _("%s: Reading system file: %s."),
1769                fh_get_file_name (r->fh), strerror (errno));
1770           r->ok = false; 
1771         }
1772       else if (read_bytes != 0) 
1773         {
1774           msg (ME, _("%s: Partial record at end of system file."),
1775                fh_get_file_name (r->fh));
1776           r->ok = false; 
1777         }
1778       return 0;
1779     }
1780 }
1781 \f
1782 /* Returns true if an I/O error has occurred on READER, false
1783    otherwise. */
1784 bool
1785 sfm_read_error (const struct sfm_reader *reader) 
1786 {
1787   return !reader->ok;
1788 }
1789
1790 /* Returns true if FILE is an SPSS system file,
1791    false otherwise. */
1792 bool
1793 sfm_detect (FILE *file) 
1794 {
1795   struct sysfile_header hdr;
1796
1797   if (fread (&hdr, sizeof hdr, 1, file) != 1)
1798     return false;
1799   if (strncmp ("$FL2", hdr.rec_type, 4))
1800     return false;
1801   return true; 
1802 }
1803