Made array.h const correct, and dealt with the consequences.
[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 (weight_var->type == ALPHA)
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                       v->measure = params.measure;
469                       v->display_width = params.width;
470                       v->alignment = 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 ( v->width > EFFECTIVE_LONG_STRING_LENGTH ) 
634                                 l -= EFFECTIVE_LONG_STRING_LENGTH;
635                               else
636                                 l -= v->width;
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 ( v_next->width > EFFECTIVE_LONG_STRING_LENGTH ) 
645                                     l -= EFFECTIVE_LONG_STRING_LENGTH;
646                                   else
647                                     l -= v_next->width;
648
649                                   dict_delete_var(*dict, v_next);
650                                 }
651
652                               assert ( length > MAX_LONG_STRING );
653
654                               v->width = length;
655                               v->print.w = v->width;
656                               v->write.w = v->width;
657                               v->nv = DIV_RND_UP (length, MAX_SHORT_STRING);
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 = v->width;
729         sv->fv = v->fv; 
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
1019       assertive_buf_read (r, &sv, sizeof sv, 0);
1020
1021       if (r->reverse_endian)
1022         {
1023           bswap_int32 (&sv.rec_type);
1024           bswap_int32 (&sv.type);
1025           bswap_int32 (&sv.has_var_label);
1026           bswap_int32 (&sv.n_missing_values);
1027           bswap_int32 (&sv.print);
1028           bswap_int32 (&sv.write);
1029         }
1030
1031       /* We've come to the end of the variable entries */
1032       if (sv.rec_type != 2)
1033         {
1034           buf_unread(r, sizeof sv);
1035           r->value_cnt = i;
1036           break;
1037         }
1038
1039       *var_by_idx = xnrealloc (*var_by_idx, i + 1, sizeof **var_by_idx);
1040
1041       /* If there was a long string previously, make sure that the
1042          continuations are present; otherwise make sure there aren't
1043          any. */
1044       if (long_string_count)
1045         {
1046           if (sv.type != -1)
1047             lose ((ME, _("%s: position %d: String variable does not have "
1048                          "proper number of continuation records."),
1049                    fh_get_file_name (r->fh), i));
1050
1051
1052           (*var_by_idx)[i] = NULL;
1053           long_string_count--;
1054           continue;
1055         }
1056       else if (sv.type == -1)
1057         lose ((ME, _("%s: position %d: Superfluous long string continuation "
1058                      "record."),
1059                fh_get_file_name (r->fh), i));
1060
1061       /* Check fields for validity. */
1062       if (sv.type < 0 || sv.type > 255)
1063         lose ((ME, _("%s: position %d: Bad variable type code %d."),
1064                fh_get_file_name (r->fh), i, sv.type));
1065       if (sv.has_var_label != 0 && sv.has_var_label != 1)
1066         lose ((ME, _("%s: position %d: Variable label indicator field is not "
1067                      "0 or 1."), fh_get_file_name (r->fh), i));
1068       if (sv.n_missing_values < -3 || sv.n_missing_values > 3
1069           || sv.n_missing_values == -1)
1070         lose ((ME, _("%s: position %d: Missing value indicator field is not "
1071                      "-3, -2, 0, 1, 2, or 3."), fh_get_file_name (r->fh), i));
1072
1073       /* Copy first character of variable name. */
1074       if (sv.name[0] == '@' || sv.name[0] == '#')
1075         lose ((ME, _("%s: position %d: Variable name begins with invalid "
1076                      "character."),
1077                fh_get_file_name (r->fh), i));
1078
1079       name[0] = sv.name[0];
1080
1081       /* Copy remaining characters of variable name. */
1082       for (j = 1; j < SHORT_NAME_LEN; j++)
1083         {
1084           int c = (unsigned char) sv.name[j];
1085
1086           if (c == ' ') 
1087             break;
1088           else 
1089             name[j] = c;
1090         }
1091       name[j] = 0;
1092
1093       if ( ! var_is_plausible_name(name, false) ) 
1094         lose ((ME, _("%s: Invalid variable name `%s' within system file."),
1095                fh_get_file_name (r->fh), name));
1096
1097       /* Create variable. */
1098       vv = (*var_by_idx)[i] = dict_create_var (dict, name, sv.type);
1099       if (vv == NULL) 
1100         lose ((ME, _("%s: Duplicate variable name `%s' within system file."),
1101                fh_get_file_name (r->fh), name));
1102
1103       /* Set the short name the same as the long name */
1104       var_set_short_name (vv, vv->name);
1105
1106       /* Case reading data. */
1107       nv = sv.type == 0 ? 1 : DIV_RND_UP (sv.type, sizeof (flt64));
1108       long_string_count = nv - 1;
1109       next_value += nv;
1110
1111       /* Get variable label, if any. */
1112       if (sv.has_var_label == 1)
1113         {
1114           /* Disk buffer. */
1115           int32_t len;
1116
1117           /* Read length of label. */
1118           assertive_buf_read (r, &len, sizeof len, 0);
1119           if (r->reverse_endian)
1120             bswap_int32 (&len);
1121
1122           /* Check len. */
1123           if (len < 0 || len > 255)
1124             lose ((ME, _("%s: Variable %s indicates variable label of invalid "
1125                          "length %d."),
1126                    fh_get_file_name (r->fh), vv->name, len));
1127
1128           if ( len != 0 ) 
1129             {
1130               /* Read label into variable structure. */
1131               vv->label = buf_read (r, NULL, ROUND_UP (len, sizeof (int32_t)), len + 1);
1132               if (vv->label == NULL)
1133                 goto error;
1134               vv->label[len] = '\0';
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
1144           if (vv->width > MAX_SHORT_STRING)
1145             lose ((ME, _("%s: Long string variable %s may not have missing "
1146                          "values."),
1147                    fh_get_file_name (r->fh), vv->name));
1148
1149           assertive_buf_read (r, mv, sizeof *mv * mv_cnt, 0);
1150
1151           if (r->reverse_endian && vv->type == NUMERIC)
1152             for (j = 0; j < mv_cnt; j++)
1153               bswap_flt64 (&mv[j]);
1154
1155           if (sv.n_missing_values > 0)
1156             {
1157               for (j = 0; j < sv.n_missing_values; j++)
1158                 if (vv->type == NUMERIC)
1159                   mv_add_num (&vv->miss, mv[j]);
1160                 else
1161                   mv_add_str (&vv->miss, (char *) &mv[j]);
1162             }
1163           else
1164             {
1165               if (vv->type == ALPHA)
1166                 lose ((ME, _("%s: String variable %s may not have missing "
1167                              "values specified as a range."),
1168                        fh_get_file_name (r->fh), vv->name));
1169
1170               if (mv[0] == r->lowest)
1171                 mv_add_num_range (&vv->miss, LOWEST, mv[1]);
1172               else if (mv[1] == r->highest)
1173                 mv_add_num_range (&vv->miss, mv[0], HIGHEST);
1174               else
1175                 mv_add_num_range (&vv->miss, mv[0], mv[1]);
1176
1177               if (sv.n_missing_values == -3)
1178                 mv_add_num (&vv->miss, mv[2]);
1179             }
1180         }
1181
1182       if (!parse_format_spec (r, sv.print, &vv->print, vv)
1183           || !parse_format_spec (r, sv.write, &vv->write, vv))
1184         goto error;
1185     }
1186
1187   /* Some consistency checks. */
1188   if (long_string_count != 0)
1189     lose ((ME, _("%s: Long string continuation records omitted at end of "
1190                  "dictionary."),
1191            fh_get_file_name (r->fh)));
1192
1193   if (next_value != r->value_cnt)
1194     corrupt_msg(MW, _("%s: System file header indicates %d variable positions but "
1195                       "%d were read from file."),
1196                 fh_get_file_name (r->fh), r->value_cnt, next_value);
1197
1198
1199   return 1;
1200
1201  error:
1202   return 0;
1203 }
1204
1205 /* Translates the format spec from sysfile format to internal
1206    format. */
1207 static int
1208 parse_format_spec (struct sfm_reader *r, int32_t s,
1209                    struct fmt_spec *f, const struct variable *v)
1210 {
1211   f->type = translate_fmt ((s >> 16) & 0xff);
1212   if (f->type == -1)
1213     lose ((ME, _("%s: Bad format specifier byte (%d)."),
1214            fh_get_file_name (r->fh), (s >> 16) & 0xff));
1215   f->w = (s >> 8) & 0xff;
1216   f->d = s & 0xff;
1217
1218   if ((v->type == ALPHA) ^ ((formats[f->type].cat & FCAT_STRING) != 0))
1219     lose ((ME, _("%s: %s variable %s has %s format specifier %s."),
1220            fh_get_file_name (r->fh),
1221            v->type == ALPHA ? _("String") : _("Numeric"),
1222            v->name,
1223            formats[f->type].cat & FCAT_STRING ? _("string") : _("numeric"),
1224            formats[f->type].name));
1225
1226   if (!check_output_specifier (f, false)
1227       || !check_specifier_width (f, v->width, false)) 
1228     {
1229       msg (ME, _("%s variable %s has invalid format specifier %s."),
1230            v->type == NUMERIC ? _("Numeric") : _("String"),
1231            v->name, fmt_to_string (f));
1232       *f = v->type == NUMERIC ? f8_2 : make_output_format (FMT_A, v->width, 0);
1233     }
1234   return 1;
1235
1236  error:
1237   return 0;
1238 }
1239
1240 /* Reads value labels from sysfile H and inserts them into the
1241    associated dictionary. */
1242 int
1243 read_value_labels (struct sfm_reader *r,
1244                    struct dictionary *dict, struct variable **var_by_idx)
1245 {
1246   struct label 
1247   {
1248     char raw_value[8];        /* Value as uninterpreted bytes. */
1249     union value value;        /* Value. */
1250     char *label;              /* Null-terminated label string. */
1251   };
1252
1253   struct label *labels = NULL;
1254   int32_t n_labels;             /* Number of labels. */
1255
1256   struct variable **var = NULL; /* Associated variables. */
1257   int32_t n_vars;                       /* Number of associated variables. */
1258
1259   int i;
1260
1261   /* First step: read the contents of the type 3 record and record its
1262      contents.  Note that we can't do much with the data since we
1263      don't know yet whether it is of numeric or string type. */
1264
1265   /* Read number of labels. */
1266   assertive_buf_read (r, &n_labels, sizeof n_labels, 0);
1267   if (r->reverse_endian)
1268     bswap_int32 (&n_labels);
1269
1270   if ( n_labels >= ((int32_t) ~0) / sizeof *labels)
1271     {    
1272       corrupt_msg(MW, _("%s: Invalid number of labels: %d.  Ignoring labels."),
1273                   fh_get_file_name (r->fh), n_labels);
1274       n_labels = 0;
1275     }
1276
1277   /* Allocate memory. */
1278   labels = xcalloc (n_labels, sizeof *labels);
1279   for (i = 0; i < n_labels; i++)
1280     labels[i].label = NULL;
1281
1282   /* Read each value/label tuple into labels[]. */
1283   for (i = 0; i < n_labels; i++)
1284     {
1285       struct label *label = labels + i;
1286       unsigned char label_len;
1287       size_t padded_len;
1288
1289       /* Read value. */
1290       assertive_buf_read (r, label->raw_value, sizeof label->raw_value, 0);
1291
1292       /* Read label length. */
1293       assertive_buf_read (r, &label_len, sizeof label_len, 0);
1294       padded_len = ROUND_UP (label_len + 1, sizeof (flt64));
1295
1296       /* Read label, padding. */
1297       label->label = xmalloc (padded_len + 1);
1298       assertive_buf_read (r, label->label, padded_len - 1, 0);
1299       label->label[label_len] = 0;
1300     }
1301
1302   /* Second step: Read the type 4 record that has the list of
1303      variables to which the value labels are to be applied. */
1304
1305   /* Read record type of type 4 record. */
1306   {
1307     int32_t rec_type;
1308     
1309     assertive_buf_read (r, &rec_type, sizeof rec_type, 0);
1310     if (r->reverse_endian)
1311       bswap_int32 (&rec_type);
1312     
1313     if (rec_type != 4)
1314       lose ((ME, _("%s: Variable index record (type 4) does not immediately "
1315                    "follow value label record (type 3) as it should."),
1316              fh_get_file_name (r->fh)));
1317   }
1318
1319   /* Read number of variables associated with value label from type 4
1320      record. */
1321   assertive_buf_read (r, &n_vars, sizeof n_vars, 0);
1322   if (r->reverse_endian)
1323     bswap_int32 (&n_vars);
1324   if (n_vars < 1 || n_vars > dict_get_var_cnt (dict))
1325     lose ((ME, _("%s: Number of variables associated with a value label (%d) "
1326                  "is not between 1 and the number of variables (%d)."),
1327            fh_get_file_name (r->fh), n_vars, dict_get_var_cnt (dict)));
1328
1329   /* Read the list of variables. */
1330   var = xnmalloc (n_vars, sizeof *var);
1331   for (i = 0; i < n_vars; i++)
1332     {
1333       int32_t var_idx;
1334       struct variable *v;
1335
1336       /* Read variable index, check range. */
1337       assertive_buf_read (r, &var_idx, sizeof var_idx, 0);
1338       if (r->reverse_endian)
1339         bswap_int32 (&var_idx);
1340       if (var_idx < 1 || var_idx > r->value_cnt)
1341         lose ((ME, _("%s: Variable index associated with value label (%d) is "
1342                      "not between 1 and the number of values (%d)."),
1343                fh_get_file_name (r->fh), var_idx, r->value_cnt));
1344
1345       /* Make sure it's a real variable. */
1346       v = var_by_idx[var_idx - 1];
1347       if (v == NULL)
1348         lose ((ME, _("%s: Variable index associated with value label (%d) "
1349                      "refers to a continuation of a string variable, not to "
1350                      "an actual variable."),
1351                fh_get_file_name (r->fh), var_idx));
1352       if (v->type == ALPHA && v->width > MAX_SHORT_STRING)
1353         lose ((ME, _("%s: Value labels are not allowed on long string "
1354                      "variables (%s)."),
1355                fh_get_file_name (r->fh), v->name));
1356
1357       /* Add it to the list of variables. */
1358       var[i] = v;
1359     }
1360
1361   /* Type check the variables. */
1362   for (i = 1; i < n_vars; i++)
1363     if (var[i]->type != var[0]->type)
1364       lose ((ME, _("%s: Variables associated with value label are not all of "
1365                    "identical type.  Variable %s has %s type, but variable "
1366                    "%s has %s type."),
1367              fh_get_file_name (r->fh),
1368              var[0]->name, var[0]->type == ALPHA ? _("string") : _("numeric"),
1369              var[i]->name, var[i]->type == ALPHA ? _("string") : _("numeric")));
1370
1371   /* Fill in labels[].value, now that we know the desired type. */
1372   for (i = 0; i < n_labels; i++) 
1373     {
1374       struct label *label = labels + i;
1375       
1376       if (var[0]->type == ALPHA)
1377         {
1378           const int copy_len = min (sizeof label->raw_value,
1379                                     sizeof label->label);
1380           memcpy (label->value.s, label->raw_value, copy_len);
1381         } else {
1382           flt64 f;
1383           assert (sizeof f == sizeof label->raw_value);
1384           memcpy (&f, label->raw_value, sizeof f);
1385           if (r->reverse_endian)
1386             bswap_flt64 (&f);
1387           label->value.f = f;
1388         }
1389     }
1390   
1391   /* Assign the value_label's to each variable. */
1392   for (i = 0; i < n_vars; i++)
1393     {
1394       struct variable *v = var[i];
1395       int j;
1396
1397       /* Add each label to the variable. */
1398       for (j = 0; j < n_labels; j++)
1399         {
1400           struct label *label = labels + j;
1401           if (!val_labs_replace (v->val_labs, label->value, label->label))
1402             continue;
1403
1404           if (var[0]->type == NUMERIC)
1405             msg (MW, _("%s: File contains duplicate label for value %g for "
1406                        "variable %s."),
1407                  fh_get_file_name (r->fh), label->value.f, v->name);
1408           else
1409             msg (MW, _("%s: File contains duplicate label for value `%.*s' "
1410                        "for variable %s."),
1411                  fh_get_file_name (r->fh), v->width, label->value.s, v->name);
1412         }
1413     }
1414
1415   for (i = 0; i < n_labels; i++)
1416     free (labels[i].label);
1417   free (labels);
1418   free (var);
1419   return 1;
1420
1421  error:
1422   if (labels) 
1423     {
1424       for (i = 0; i < n_labels; i++)
1425         free (labels[i].label);
1426       free (labels); 
1427     }
1428   free (var);
1429   return 0;
1430 }
1431
1432 /* Reads BYTE_CNT bytes from the file represented by H.  If BUF is
1433    non-NULL, uses that as the buffer; otherwise allocates at least
1434    MIN_ALLOC bytes.  Returns a pointer to the buffer on success, NULL
1435    on failure. */
1436 static void *
1437 buf_read (struct sfm_reader *r, void *buf, size_t byte_cnt, size_t min_alloc)
1438 {
1439   assert (r);
1440
1441   if (buf == NULL && byte_cnt > 0 )
1442     buf = xmalloc (max (byte_cnt, min_alloc));
1443
1444   if ( byte_cnt == 0 )
1445     return buf;
1446
1447   
1448   if (1 != fread (buf, byte_cnt, 1, r->file))
1449     {
1450       if (ferror (r->file))
1451         msg (ME, _("%s: Reading system file: %s."),
1452              fh_get_file_name (r->fh), strerror (errno));
1453       else
1454         corrupt_msg (ME, _("%s: Unexpected end of file."),
1455                      fh_get_file_name (r->fh));
1456       r->ok = false;
1457       return NULL;
1458     }
1459
1460   return buf;
1461 }
1462
1463 /* Winds the reader BYTE_CNT bytes back in the reader stream.   */
1464 void
1465 buf_unread(struct sfm_reader *r, size_t byte_cnt)
1466 {
1467   assert(byte_cnt > 0);
1468
1469   if ( 0 != fseek(r->file, -byte_cnt, SEEK_CUR))
1470     {
1471       msg (ME, _("%s: Seeking system file: %s."),
1472            fh_get_file_name (r->fh), strerror (errno));
1473     }
1474 }
1475
1476 /* Reads a document record, type 6, from system file R, and sets up
1477    the documents and n_documents fields in the associated
1478    dictionary. */
1479 static int
1480 read_documents (struct sfm_reader *r, struct dictionary *dict)
1481 {
1482   int32_t line_cnt;
1483   char *documents;
1484
1485   if (dict_get_documents (dict) != NULL)
1486     lose ((ME, _("%s: System file contains multiple "
1487                  "type 6 (document) records."),
1488            fh_get_file_name (r->fh)));
1489
1490   assertive_buf_read (r, &line_cnt, sizeof line_cnt, 0);
1491   if (line_cnt <= 0)
1492     lose ((ME, _("%s: Number of document lines (%ld) "
1493                  "must be greater than 0."),
1494            fh_get_file_name (r->fh), (long) line_cnt));
1495
1496   documents = buf_read (r, NULL, 80 * line_cnt, line_cnt * 80 + 1);
1497   /* FIXME?  Run through asciify. */
1498   if (documents == NULL)
1499     return 0;
1500   documents[80 * line_cnt] = '\0';
1501   dict_set_documents (dict, documents);
1502   free (documents);
1503   return 1;
1504
1505  error:
1506   return 0;
1507 }
1508 \f
1509 /* Data reader. */
1510
1511 /* Reads compressed data into H->BUF and sets other pointers
1512    appropriately.  Returns nonzero only if both no errors occur and
1513    data was read. */
1514 static int
1515 buffer_input (struct sfm_reader *r)
1516 {
1517   size_t amt;
1518
1519   if (!r->ok)
1520     return false;
1521   if (r->buf == NULL)
1522     r->buf = xnmalloc (128, sizeof *r->buf);
1523   amt = fread (r->buf, sizeof *r->buf, 128, r->file);
1524   if (ferror (r->file))
1525     {
1526       msg (ME, _("%s: Error reading file: %s."),
1527            fh_get_file_name (r->fh), strerror (errno));
1528       r->ok = false;
1529       return 0;
1530     }
1531   r->ptr = r->buf;
1532   r->end = &r->buf[amt];
1533   return amt;
1534 }
1535
1536 /* Reads a single case consisting of compressed data from system
1537    file H into the array BUF[] according to reader R, and
1538    returns nonzero only if successful. */
1539 /* Data in system files is compressed in this manner.  Data
1540    values are grouped into sets of eight ("octets").  Each value
1541    in an octet has one instruction byte that are output together.
1542    Each instruction byte gives a value for that byte or indicates
1543    that the value can be found following the instructions. */
1544 static int
1545 read_compressed_data (struct sfm_reader *r, flt64 *buf)
1546 {
1547   const unsigned char *p_end = r->x + sizeof (flt64);
1548   unsigned char *p = r->y;
1549
1550   const flt64 *buf_beg = buf;
1551   const flt64 *buf_end = &buf[r->value_cnt];
1552
1553   for (;;)
1554     {
1555       for (; p < p_end; p++){
1556         switch (*p)
1557           {
1558           case 0:
1559             /* Code 0 is ignored. */
1560             continue;
1561           case 252:
1562             /* Code 252 is end of file. */
1563             if (buf_beg == buf)
1564               return 0;
1565             lose ((ME, _("%s: Compressed data is corrupted.  Data ends "
1566                          "in partial case."),
1567                    fh_get_file_name (r->fh)));
1568           case 253:
1569             /* Code 253 indicates that the value is stored explicitly
1570                following the instruction bytes. */
1571             if (r->ptr == NULL || r->ptr >= r->end)
1572               if (!buffer_input (r))
1573                 lose ((ME, _("%s: Unexpected end of file."),
1574                        fh_get_file_name (r->fh)));
1575             memcpy (buf++, r->ptr++, sizeof *buf);
1576             if (buf >= buf_end)
1577               goto success;
1578             break;
1579           case 254:
1580             /* Code 254 indicates a string that is all blanks. */
1581             memset (buf++, ' ', sizeof *buf);
1582             if (buf >= buf_end)
1583               goto success;
1584             break;
1585           case 255:
1586             /* Code 255 indicates the system-missing value. */
1587             *buf = r->sysmis;
1588             if (r->reverse_endian)
1589               bswap_flt64 (buf);
1590             buf++;
1591             if (buf >= buf_end)
1592               goto success;
1593             break;
1594           default:
1595             /* Codes 1 through 251 inclusive are taken to indicate a
1596                value of (BYTE - BIAS), where BYTE is the byte's value
1597                and BIAS is the compression bias (generally 100.0). */
1598             *buf = *p - r->bias;
1599             if (r->reverse_endian)
1600               bswap_flt64 (buf);
1601             buf++;
1602             if (buf >= buf_end)
1603               goto success;
1604             break;
1605           }
1606       }
1607       /* We have reached the end of this instruction octet.  Read
1608          another. */
1609       if (r->ptr == NULL || r->ptr >= r->end) 
1610         {
1611           if (!buffer_input (r))
1612             {
1613               if (buf_beg != buf)
1614                 lose ((ME, _("%s: Unexpected end of file."),
1615                        fh_get_file_name (r->fh))); 
1616               else
1617                 return 0;
1618             }
1619         }
1620       memcpy (r->x, r->ptr++, sizeof *buf);
1621       p = r->x;
1622     }
1623
1624   NOT_REACHED ();
1625
1626  success:
1627   /* We have filled up an entire record.  Update state and return
1628      successfully. */
1629   r->y = ++p;
1630   return 1;
1631
1632  error:
1633   /* I/O error. */
1634   r->ok = false;
1635   return 0;
1636 }
1637
1638 /* Reads one case from READER's file into C.  Returns nonzero
1639    only if successful. */
1640 int
1641 sfm_read_case (struct sfm_reader *r, struct ccase *c)
1642 {
1643   if (!r->ok)
1644     return 0;
1645
1646   if (!r->compressed && sizeof (flt64) == sizeof (double) && ! r->has_vls) 
1647     {
1648       /* Fast path: external and internal representations are the
1649          same, except possibly for endianness or SYSMIS.  Read
1650          directly into the case's buffer, then fix up any minor
1651          details as needed. */
1652       if (!fread_ok (r, case_data_all_rw (c),
1653                      sizeof (union value) * r->value_cnt))
1654         return 0;
1655
1656       /* Fix up endianness if needed. */
1657       if (r->reverse_endian) 
1658         {
1659           int i;
1660           
1661           for (i = 0; i < r->var_cnt; i++) 
1662             if (r->vars[i].width == 0)
1663               bswap_flt64 (&case_data_rw (c, r->vars[i].fv)->f);
1664         }
1665
1666       /* Fix up SYSMIS values if needed.
1667          I don't think this will ever actually kick in, but it
1668          can't hurt. */
1669       if (r->sysmis != SYSMIS) 
1670         {
1671           int i;
1672           
1673           for (i = 0; i < r->var_cnt; i++) 
1674             if (r->vars[i].width == 0 && case_num (c, i) == r->sysmis)
1675               case_data_rw (c, r->vars[i].fv)->f = SYSMIS;
1676         }
1677     }
1678   else 
1679     {
1680       /* Slow path: internal and external representations differ.
1681          Read into a bounce buffer, then copy to C. */
1682       flt64 *bounce;
1683       flt64 *bounce_cur;
1684       size_t bounce_size;
1685       int read_ok;
1686       int i;
1687
1688       bounce_size = sizeof *bounce * r->value_cnt;
1689       bounce = bounce_cur = local_alloc (bounce_size);
1690
1691       memset(bounce, 0, bounce_size);
1692
1693       if (!r->compressed)
1694         read_ok = fread_ok (r, bounce, bounce_size);
1695       else
1696         read_ok = read_compressed_data (r, bounce);
1697       if (!read_ok) 
1698         {
1699           local_free (bounce);
1700           return 0;
1701         }
1702
1703       for (i = 0; i < r->var_cnt; i++)
1704         {
1705           struct sfm_var *sv = &r->vars[i];
1706
1707           if (sv->width == 0)
1708             {
1709               flt64 f = *bounce_cur++;
1710               if (r->reverse_endian)
1711                 bswap_flt64 (&f);
1712               case_data_rw (c, sv->fv)->f = f == r->sysmis ? SYSMIS : f;
1713             }
1714           else
1715             {
1716               flt64 *bc_start = bounce_cur;
1717               int ofs = 0;
1718               while (ofs < sv->width )
1719                 {
1720                   const int chunk = MIN (MAX_LONG_STRING, sv->width - ofs);
1721                   memcpy (case_data_rw (c, sv->fv)->s + ofs, bounce_cur, chunk);
1722
1723                   bounce_cur += DIV_RND_UP (chunk, sizeof (flt64));
1724
1725                   ofs += chunk;
1726                 }
1727               bounce_cur = bc_start + width_to_bytes(sv->width) / sizeof(flt64);
1728             }
1729         }
1730
1731       local_free (bounce);
1732     }
1733   return 1; 
1734 }
1735
1736 static int
1737 fread_ok (struct sfm_reader *r, void *buffer, size_t byte_cnt)
1738 {
1739   size_t read_bytes = fread (buffer, 1, byte_cnt, r->file);
1740
1741   if (read_bytes == byte_cnt)
1742     return 1;
1743   else
1744     {
1745       if (ferror (r->file)) 
1746         {
1747           msg (ME, _("%s: Reading system file: %s."),
1748                fh_get_file_name (r->fh), strerror (errno));
1749           r->ok = false; 
1750         }
1751       else if (read_bytes != 0) 
1752         {
1753           msg (ME, _("%s: Partial record at end of system file."),
1754                fh_get_file_name (r->fh));
1755           r->ok = false; 
1756         }
1757       return 0;
1758     }
1759 }
1760 \f
1761 /* Returns true if an I/O error has occurred on READER, false
1762    otherwise. */
1763 bool
1764 sfm_read_error (const struct sfm_reader *reader) 
1765 {
1766   return !reader->ok;
1767 }
1768
1769 /* Returns true if FILE is an SPSS system file,
1770    false otherwise. */
1771 bool
1772 sfm_detect (FILE *file) 
1773 {
1774   struct sysfile_header hdr;
1775
1776   if (fread (&hdr, sizeof hdr, 1, file) != 1)
1777     return false;
1778   if (strncmp ("$FL2", hdr.rec_type, 4))
1779     return false;
1780   return true; 
1781 }
1782