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