Added a --enable-debug option to configure and
[pspp-builds.git] / src / sfm-read.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 1997-9, 2000 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., 59 Temple Place - Suite 330, Boston, MA
18    02111-1307, USA. */
19
20 /* AIX requires this to be the first thing in the file.  */
21 #include <config.h>
22 #if __GNUC__
23 #define alloca __builtin_alloca
24 #else
25 #if HAVE_ALLOCA_H
26 #include <alloca.h>
27 #else
28 #ifdef _AIX
29 #pragma alloca
30 #else
31 #ifndef alloca                  /* predefined by HP cc +Olibcalls */
32 char *alloca ();
33 #endif
34 #endif
35 #endif
36 #endif
37
38 #include <assert.h>
39 #include <stdlib.h>
40 #include <ctype.h>
41 #include <errno.h>
42 #include <float.h>
43 #include "alloc.h"
44 #include "avl.h"
45 #include "error.h"
46 #include "file-handle.h"
47 #include "filename.h"
48 #include "format.h"
49 #include "getline.h"
50 #include "magic.h"
51 #include "misc.h"
52 #include "sfm.h"
53 #include "sfmP.h"
54 #include "str.h"
55 #include "var.h"
56
57 #include "debug-print.h"
58
59 /* PORTME: This file may require substantial revision for those
60    systems that don't meet the typical 32-bit integer/64-bit double
61    model.  It's kinda hard to tell without having one of them on my
62    desk.  */
63
64 /* sfm's file_handle extension. */
65 struct sfm_fhuser_ext
66   {
67     FILE *file;                 /* Actual file. */
68     int opened;                 /* Reference count. */
69
70     struct dictionary *dict;    /* File's dictionary. */
71
72     int reverse_endian;         /* 1=file has endianness opposite us. */
73     int case_size;              /* Number of `values's per case. */
74     long ncases;                /* Number of cases, -1 if unknown. */
75     int compressed;             /* 1=compressed, 0=not compressed. */
76     double bias;                /* Compression bias, usually 100.0. */
77     int weight_index;           /* 0-based index of weighting variable, or -1. */
78
79     /* File's special constants. */
80     flt64 sysmis;
81     flt64 highest;
82     flt64 lowest;
83
84     /* Uncompression buffer. */
85     flt64 *buf;                 /* Buffer data. */
86     flt64 *ptr;                 /* Current location in buffer. */
87     flt64 *end;                 /* End of buffer data. */
88
89     /* Compression instruction octet. */
90     unsigned char x[sizeof (flt64)];
91     /* Current instruction octet. */
92     unsigned char *y;           /* Location in current instruction octet. */
93   };
94
95 static struct fh_ext_class sfm_r_class;
96
97 #if GLOBAL_DEBUGGING
98 void dump_dictionary (struct dictionary * dict);
99 #endif
100 \f
101 /* Utilities. */
102
103 /* bswap_int32(): Reverse the byte order of 32-bit integer *X. */
104 #if __linux__
105 #include <asm/byteorder.h>
106 #include <netinet/in.h>
107 static inline void
108 bswap_int32 (int32 * x)
109 {
110   *x = ntohl (*x);
111 }
112 #else /* not Linux */
113 static inline void
114 bswap_int32 (int32 * x)
115 {
116   unsigned char *y = (char *) x;
117   unsigned char t;
118   t = y[0];
119   y[0] = y[3];
120   y[3] = t;
121   t = y[1];
122   y[1] = y[2];
123   y[2] = t;
124 }
125 #endif /* not Linux */
126
127 /* Reverse the byte order of 64-bit floating point *X. */
128 static inline void
129 bswap_flt64 (flt64 * x)
130 {
131   /* Note that under compilers of any quality, half of this function
132      should optimize out as dead code. */
133   unsigned char *y = (char *) x;
134
135   if (sizeof (flt64) == 8)
136     {
137       unsigned char t;
138       t = y[0];
139       y[0] = y[7];
140       y[7] = t;
141       t = y[1];
142       y[1] = y[6];
143       y[6] = t;
144       t = y[2];
145       y[2] = y[5];
146       y[5] = t;
147       t = y[3];
148       y[3] = y[4];
149       y[4] = t;
150     }
151   else
152     {
153       unsigned char t;
154       size_t x;
155
156       for (x = 0; x < sizeof (flt64) / 2; x++)
157         {
158           t = y[x];
159           y[x] = y[sizeof (flt64) - x];
160           y[sizeof (flt64) - x] = t;
161         }
162     }
163 }
164
165 static void
166 corrupt_msg (int class, const char *format,...)
167   __attribute__ ((format (printf, 2, 3)));
168
169 /* Displays a corrupt sysfile error. */
170 static void
171 corrupt_msg (int class, const char *format,...)
172 {
173   char buf[1024];
174   
175   {
176     va_list args;
177
178     va_start (args, format);
179     vsnprintf (buf, 1024, format, args);
180     va_end (args);
181   }
182   
183   {
184     struct error e;
185
186     e.class = class;
187     getl_location (&e.where.filename, &e.where.line_number);
188     e.title = _("corrupt system file: ");
189     e.text = buf;
190
191     err_vmsg (&e);
192   }
193 }
194
195 /* Closes a system file after we're done with it. */
196 static void
197 sfm_close (struct file_handle * h)
198 {
199   struct sfm_fhuser_ext *ext = h->ext;
200
201   ext->opened--;
202   assert (ext->opened == 0);
203   if (EOF == fn_close (h->fn, ext->file))
204     msg (ME, _("%s: Closing system file: %s."), h->fn, strerror (errno));
205   free (ext->buf);
206   free (h->ext);
207 }
208
209 /* Closes a system file if we're done with it. */
210 void
211 sfm_maybe_close (struct file_handle *h)
212 {
213   struct sfm_fhuser_ext *ext = h->ext;
214
215   if (ext->opened == 1)
216     fh_close_handle (h);
217   else
218     ext->opened--;
219 }
220 \f
221 /* Dictionary reader. */
222
223 static void *bufread (struct file_handle * handle, void *buf, size_t nbytes,
224                       size_t minalloc);
225
226 static int read_header (struct file_handle * h, struct sfm_read_info * inf);
227 static int parse_format_spec (struct file_handle * h, int32 s,
228                               struct fmt_spec * v, struct variable *vv);
229 static int read_value_labels (struct file_handle * h, struct variable ** var_by_index);
230 static int read_variables (struct file_handle * h, struct variable *** var_by_index);
231 static int read_machine_int32_info (struct file_handle * h, int size, int count);
232 static int read_machine_flt64_info (struct file_handle * h, int size, int count);
233 static int read_documents (struct file_handle * h);
234
235 /* Displays the message X with corrupt_msg, then jumps to the lossage
236    label. */
237 #define lose(X)                                 \
238         do                                      \
239           {                                     \
240             corrupt_msg X;                      \
241             goto lossage;                       \
242           }                                     \
243         while (0)
244
245 /* Calls bufread with the specified arguments, and jumps to lossage if
246    the read fails. */
247 #define assertive_bufread(a,b,c,d)              \
248         do                                      \
249           {                                     \
250             if (!bufread (a,b,c,d))             \
251               goto lossage;                     \
252           }                                     \
253         while (0)
254
255 /* Reads the dictionary from file with handle H, and returns it in a
256    dictionary structure.  This dictionary may be modified in order to
257    rename, reorder, and delete variables, etc.  */
258 struct dictionary *
259 sfm_read_dictionary (struct file_handle * h, struct sfm_read_info * inf)
260 {
261   /* The file handle extension record. */
262   struct sfm_fhuser_ext *ext;
263
264   /* Allows for quick reference to variables according to indexes
265      relative to position within a case. */
266   struct variable **var_by_index = NULL;
267
268   /* Check whether the file is already open. */
269   if (h->class == &sfm_r_class)
270     {
271       ext = h->ext;
272       ext->opened++;
273       return ext->dict;
274     }
275   else if (h->class != NULL)
276     {
277       msg (ME, _("Cannot read file %s as system file: already opened for %s."),
278            fh_handle_name (h), h->class->name);
279       return NULL;
280     }
281
282   msg (VM (1), _("%s: Opening system-file handle %s for reading."),
283        fh_handle_filename (h), fh_handle_name (h));
284   
285   /* Open the physical disk file. */
286   ext = xmalloc (sizeof (struct sfm_fhuser_ext));
287   ext->file = fn_open (h->norm_fn, "rb");
288   if (ext->file == NULL)
289     {
290       msg (ME, _("An error occurred while opening \"%s\" for reading "
291            "as a system file: %s."), h->fn, strerror (errno));
292       err_cond_fail ();
293       free (ext);
294       return NULL;
295     }
296
297   /* Initialize the sfm_fhuser_ext structure. */
298   h->class = &sfm_r_class;
299   h->ext = ext;
300   ext->dict = NULL;
301   ext->buf = ext->ptr = ext->end = NULL;
302   ext->y = ext->x + sizeof ext->x;
303   ext->opened = 1;
304
305   /* Default special constants. */
306   ext->sysmis = -FLT64_MAX;
307   ext->highest = FLT64_MAX;
308   ext->lowest = second_lowest_flt64;
309
310   /* Read the header. */
311   if (!read_header (h, inf))
312     goto lossage;
313
314   /* Read about the variables. */
315   if (!read_variables (h, &var_by_index))
316     goto lossage;
317
318   /* Handle weighting. */
319   if (ext->weight_index != -1)
320     {
321       struct variable *wv = var_by_index[ext->weight_index];
322
323       if (wv == NULL)
324         lose ((ME, _("%s: Weighting variable may not be a continuation of "
325                "a long string variable."), h->fn));
326       else if (wv->type == ALPHA)
327         lose ((ME, _("%s: Weighting variable may not be a string variable."),
328                h->fn));
329
330       strcpy (ext->dict->weight_var, wv->name);
331     }
332   else
333     ext->dict->weight_var[0] = 0;
334
335   /* Read records of types 3, 4, 6, and 7. */
336   for (;;)
337     {
338       int32 rec_type;
339
340       assertive_bufread (h, &rec_type, sizeof rec_type, 0);
341       if (ext->reverse_endian)
342         bswap_int32 (&rec_type);
343
344       switch (rec_type)
345         {
346         case 3:
347           if (!read_value_labels (h, var_by_index))
348             goto lossage;
349           break;
350
351         case 4:
352           lose ((ME, _("%s: Orphaned variable index record (type 4).  Type 4 "
353                  "records must always immediately follow type 3 records."),
354                  h->fn));
355
356         case 6:
357           if (!read_documents (h))
358             goto lossage;
359           break;
360
361         case 7:
362           {
363             struct
364               {
365                 int32 subtype P;
366                 int32 size P;
367                 int32 count P;
368               }
369             data;
370
371             int skip = 0;
372
373             assertive_bufread (h, &data, sizeof data, 0);
374             if (ext->reverse_endian)
375               {
376                 bswap_int32 (&data.subtype);
377                 bswap_int32 (&data.size);
378                 bswap_int32 (&data.count);
379               }
380
381             /*if(data.size != sizeof(int32) && data.size != sizeof(flt64))
382                lose((ME, "%s: Element size in record type 7, subtype %d, is "
383                "not either the size of IN (%d) or OBS (%d); actual value "
384                "is %d.",
385                h->fn, data.subtype, sizeof(int32), sizeof(flt64),
386                data.size)); */
387
388             switch (data.subtype)
389               {
390               case 3:
391                 if (!read_machine_int32_info (h, data.size, data.count))
392                   goto lossage;
393                 break;
394
395               case 4:
396                 if (!read_machine_flt64_info (h, data.size, data.count))
397                   goto lossage;
398                 break;
399
400               case 5:
401               case 6:
402               case 11: /* ?? Used by SPSS 8.0. */
403                 skip = 1;
404                 break;
405
406               default:
407                 msg (MW, _("%s: Unrecognized record type 7, subtype %d "
408                      "encountered in system file."), h->fn, data.subtype);
409                 skip = 1;
410               }
411
412             if (skip)
413               {
414                 void *x = bufread (h, NULL, data.size * data.count, 0);
415                 if (x == NULL)
416                   goto lossage;
417                 free (x);
418               }
419           }
420           break;
421
422         case 999:
423           {
424             int32 filler;
425
426             assertive_bufread (h, &filler, sizeof filler, 0);
427             goto break_out_of_loop;
428           }
429
430         default:
431           lose ((ME, _("%s: Unrecognized record type %d."), h->fn, rec_type));
432         }
433     }
434
435 break_out_of_loop:
436   /* Come here on successful completion. */
437   msg (VM (2), _("Read system-file dictionary successfully."));
438     
439 #if DEBUGGING
440   dump_dictionary (ext->dict);
441 #endif
442   free (var_by_index);
443   return ext->dict;
444
445 lossage:
446   /* Come here on unsuccessful completion. */
447   msg (VM (1), _("Error reading system-file header."));
448   
449   free (var_by_index);
450   fn_close (h->fn, ext->file);
451   if (ext && ext->dict)
452     free_dictionary (ext->dict);
453   free (ext);
454   h->class = NULL;
455   h->ext = NULL;
456   return NULL;
457 }
458
459 /* Read record type 7, subtype 3. */
460 static int
461 read_machine_int32_info (struct file_handle * h, int size, int count)
462 {
463   struct sfm_fhuser_ext *ext = h->ext;
464
465   int32 data[8];
466   int file_bigendian;
467
468   int i;
469
470   if (size != sizeof (int32) || count != 8)
471     lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
472            "subtype 3.  Expected size %d, count 8."),
473            h->fn, size, count, sizeof (int32)));
474
475   assertive_bufread (h, data, sizeof data, 0);
476   if (ext->reverse_endian)
477     for (i = 0; i < 8; i++)
478       bswap_int32 (&data[i]);
479
480   /* PORTME: Check floating-point representation. */
481 #ifdef FPREP_IEEE754
482   if (data[4] != 1)
483     lose ((ME, _("%s: Floating-point representation in system file is not "
484                  "IEEE-754.  PSPP cannot convert between floating-point "
485                  "formats."), h->fn));
486 #endif
487
488   /* PORTME: Check recorded file endianness against intuited file
489      endianness. */
490 #ifdef WORDS_BIGENDIAN
491   file_bigendian = 1;
492 #else
493   file_bigendian = 0;
494 #endif
495   if (ext->reverse_endian)
496     file_bigendian ^= 1;
497   if (file_bigendian ^ (data[6] == 1))
498     lose ((ME, _("%s: File-indicated endianness (%s) does not match endianness "
499            "intuited from file header (%s)."),
500            h->fn, file_bigendian ? _("big-endian") : _("little-endian"),
501            data[6] == 1 ? _("big-endian") : (data[6] == 2 ? _("little-endian")
502                                           : _("unknown"))));
503
504   /* PORTME: Character representation code. */
505   if (data[7] != 2 && data[7] != 3)
506     lose ((ME, _("%s: File-indicated character representation code (%s) is not "
507            "ASCII."), h->fn,
508        data[7] == 1 ? "EBCDIC" : (data[7] == 4 ? _("DEC Kanji") : _("Unknown"))));
509
510   return 1;
511
512 lossage:
513   return 0;
514 }
515
516 /* Read record type 7, subtype 4. */
517 static int
518 read_machine_flt64_info (struct file_handle * h, int size, int count)
519 {
520   struct sfm_fhuser_ext *ext = h->ext;
521
522   flt64 data[3];
523
524   int i;
525
526   if (size != sizeof (flt64) || count != 3)
527     lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
528            "subtype 4.  Expected size %d, count 8."),
529            h->fn, size, count, sizeof (flt64)));
530
531   assertive_bufread (h, data, sizeof data, 0);
532   if (ext->reverse_endian)
533     for (i = 0; i < 3; i++)
534       bswap_flt64 (&data[i]);
535
536   if (data[0] != SYSMIS || data[1] != FLT64_MAX
537       || data[2] != second_lowest_flt64)
538     {
539       ext->sysmis = data[0];
540       ext->highest = data[1];
541       ext->lowest = data[2];
542       msg (MW, _("%s: File-indicated value is different from internal value "
543                  "for at least one of the three system values.  SYSMIS: "
544                  "indicated %g, expected %g; HIGHEST: %g, %g; LOWEST: "
545                  "%g, %g."),
546            h->fn, (double) data[0], (double) SYSMIS,
547            (double) data[1], (double) FLT64_MAX,
548            (double) data[2], (double) second_lowest_flt64);
549     }
550   
551   return 1;
552
553 lossage:
554   return 0;
555 }
556
557 static int
558 read_header (struct file_handle * h, struct sfm_read_info * inf)
559 {
560   struct sfm_fhuser_ext *ext = h->ext;  /* File extension strcut. */
561   struct sysfile_header hdr;            /* Disk buffer. */
562   struct dictionary *dict;              /* File dictionary. */
563   char prod_name[sizeof hdr.prod_name + 1];     /* Buffer for product name. */
564   int skip_amt;                 /* Amount of product name to omit. */
565   int i;
566
567   /* Create the dictionary. */
568   dict = ext->dict = xmalloc (sizeof *dict);
569   dict->var = NULL;
570   dict->var_by_name = NULL;
571   dict->nvar = 0;
572   dict->N = 0;
573   dict->nval = -1;              /* Unknown. */
574   dict->n_splits = 0;
575   dict->splits = NULL;
576   dict->weight_var[0] = 0;
577   dict->weight_index = -1;
578   dict->filter_var[0] = 0;
579   dict->label = NULL;
580   dict->n_documents = 0;
581   dict->documents = NULL;
582
583   /* Read header, check magic. */
584   assertive_bufread (h, &hdr, sizeof hdr, 0);
585   if (0 != strncmp ("$FL2", hdr.rec_type, 4))
586     lose ((ME, _("%s: Bad magic.  Proper system files begin with "
587                  "the four characters `$FL2'. This file will not be read."),
588            h->fn));
589
590   /* Check eye-catcher string. */
591   memcpy (prod_name, hdr.prod_name, sizeof hdr.prod_name);
592   for (i = 0; i < 60; i++)
593     if (!isprint ((unsigned char) prod_name[i]))
594       prod_name[i] = ' ';
595   for (i = 59; i >= 0; i--)
596     if (!isgraph ((unsigned char) prod_name[i]))
597       {
598         prod_name[i] = '\0';
599         break;
600       }
601   prod_name[60] = '\0';
602   
603   {
604 #define N_PREFIXES 2
605     static const char *prefix[N_PREFIXES] =
606       {
607         "@(#) SPSS DATA FILE",
608         "SPSS SYSTEM FILE.",
609       };
610
611     int i;
612
613     for (i = 0; i < N_PREFIXES; i++)
614       if (!strncmp (prefix[i], hdr.prod_name, strlen (prefix[i])))
615         {
616           skip_amt = strlen (prefix[i]);
617           break;
618         }
619   }
620   
621   /* Check endianness. */
622   /* PORTME: endianness. */
623   if (hdr.layout_code == 2)
624     ext->reverse_endian = 0;
625   else
626     {
627       bswap_int32 (&hdr.layout_code);
628       if (hdr.layout_code != 2)
629         lose ((ME, _("%s: File layout code has unexpected value %d.  Value "
630                "should be 2, in big-endian or little-endian format."),
631                h->fn, hdr.layout_code));
632
633       ext->reverse_endian = 1;
634       bswap_int32 (&hdr.case_size);
635       bswap_int32 (&hdr.compressed);
636       bswap_int32 (&hdr.weight_index);
637       bswap_int32 (&hdr.ncases);
638       bswap_flt64 (&hdr.bias);
639     }
640
641   /* Copy basic info and verify correctness. */
642   ext->case_size = hdr.case_size;
643   if (hdr.case_size <= 0 || ext->case_size > (INT_MAX
644                                               / (int) sizeof (union value) / 2))
645     lose ((ME, _("%s: Number of elements per case (%d) is not between 1 "
646            "and %d."), h->fn, hdr.case_size, INT_MAX / sizeof (union value) / 2));
647
648   ext->compressed = hdr.compressed;
649
650   ext->weight_index = hdr.weight_index - 1;
651   if (hdr.weight_index < 0 || hdr.weight_index > hdr.case_size)
652     lose ((ME, _("%s: Index of weighting variable (%d) is not between 0 "
653            "and number of elements per case (%d)."),
654            h->fn, hdr.weight_index, ext->case_size));
655
656   ext->ncases = hdr.ncases;
657   if (ext->ncases < -1 || ext->ncases > INT_MAX / 2)
658     lose ((ME, _("%s: Number of cases in file (%ld) is not between -1 and "
659            "%d."), h->fn, (long) ext->ncases, INT_MAX / 2));
660
661   ext->bias = hdr.bias;
662   if (ext->bias != 100.0)
663     corrupt_msg (MW, _("%s: Compression bias (%g) is not the usual "
664                  "value of 100."), h->fn, ext->bias);
665
666   /* Make a file label only on the condition that the given label is
667      not all spaces or nulls. */
668   {
669     int i;
670
671     dict->label = NULL;
672     for (i = sizeof hdr.file_label - 1; i >= 0; i--)
673       if (!isspace ((unsigned char) hdr.file_label[i])
674           && hdr.file_label[i] != 0)
675         {
676           dict->label = xmalloc (i + 2);
677           memcpy (dict->label, hdr.file_label, i + 1);
678           dict->label[i + 1] = 0;
679           break;
680         }
681   }
682
683   if (inf)
684     {
685       char *cp;
686
687       memcpy (inf->creation_date, hdr.creation_date, 9);
688       inf->creation_date[9] = 0;
689
690       memcpy (inf->creation_time, hdr.creation_time, 8);
691       inf->creation_time[8] = 0;
692
693 #ifdef WORDS_BIGENDIAN
694       inf->bigendian = !ext->reverse_endian;
695 #else
696       inf->bigendian = ext->reverse_endian;
697 #endif
698
699       inf->compressed = hdr.compressed;
700
701       inf->ncases = hdr.ncases;
702
703       for (cp = &prod_name[skip_amt]; cp < &prod_name[60]; cp++)
704         if (isgraph ((unsigned char) *cp))
705           break;
706       strcpy (inf->product, cp);
707     }
708
709   return 1;
710
711 lossage:
712   return 0;
713 }
714
715 /* Reads most of the dictionary from file H; also fills in the
716    associated VAR_BY_INDEX array. 
717
718    Note: the dictionary returned by this function has an invalid NVAL
719    element, also the VAR[] array does not have the FV and LV elements
720    set, however the NV elements *are* set.  This is because the caller
721    will probably modify the dictionary before reading it in from the
722    file.  Also, the get.* elements are set to appropriate values to
723    allow the file to be read.  */
724 static int
725 read_variables (struct file_handle * h, struct variable *** var_by_index)
726 {
727   int i;
728
729   struct sfm_fhuser_ext *ext = h->ext;  /* File extension record. */
730   struct dictionary *dict = ext->dict;  /* Dictionary being constructed. */
731   struct sysfile_variable sv;           /* Disk buffer. */
732   int long_string_count = 0;    /* # of long string continuation
733                                    records still expected. */
734   int next_value = 0;           /* Index to next `value' structure. */
735
736   /* Allocate variables. */
737   dict->var = xmalloc (sizeof *dict->var * ext->case_size);
738   *var_by_index = xmalloc (sizeof **var_by_index * ext->case_size);
739
740   /* Read in the entry for each variable and use the info to
741      initialize the dictionary. */
742   for (i = 0; i < ext->case_size; i++)
743     {
744       struct variable *vv;
745       int j;
746
747       assertive_bufread (h, &sv, sizeof sv, 0);
748
749       if (ext->reverse_endian)
750         {
751           bswap_int32 (&sv.rec_type);
752           bswap_int32 (&sv.type);
753           bswap_int32 (&sv.has_var_label);
754           bswap_int32 (&sv.n_missing_values);
755           bswap_int32 (&sv.print);
756           bswap_int32 (&sv.write);
757         }
758
759       if (sv.rec_type != 2)
760         lose ((ME, _("%s: position %d: Bad record type (%d); "
761                "the expected value was 2."), h->fn, i, sv.rec_type));
762
763       /* If there was a long string previously, make sure that the
764          continuations are present; otherwise make sure there aren't
765          any. */
766       if (long_string_count)
767         {
768           if (sv.type != -1)
769             lose ((ME, _("%s: position %d: String variable does not have "
770                          "proper number of continuation records."), h->fn, i));
771
772           (*var_by_index)[i] = NULL;
773           long_string_count--;
774           continue;
775         }
776       else if (sv.type == -1)
777         lose ((ME, _("%s: position %d: Superfluous long string continuation "
778                "record."), h->fn, i));
779
780       /* Check fields for validity. */
781       if (sv.type < 0 || sv.type > 255)
782         lose ((ME, _("%s: position %d: Bad variable type code %d."),
783                h->fn, i, sv.type));
784       if (sv.has_var_label != 0 && sv.has_var_label != 1)
785         lose ((ME, _("%s: position %d: Variable label indicator field is not "
786                "0 or 1."), h->fn, i));
787       if (sv.n_missing_values < -3 || sv.n_missing_values > 3
788           || sv.n_missing_values == -1)
789         lose ((ME, _("%s: position %d: Missing value indicator field is not "
790                      "-3, -2, 0, 1, 2, or 3."), h->fn, i));
791
792       /* Construct internal variable structure, initialize critical bits. */
793       vv = (*var_by_index)[i] = dict->var[dict->nvar++] = xmalloc (sizeof *vv);
794       vv->index = dict->nvar - 1;
795       vv->foo = -1;
796       vv->label = NULL;
797       vv->val_lab = NULL;
798
799       /* Copy first character of variable name. */
800       if (!isalpha ((unsigned char) sv.name[0])
801           && sv.name[0] != '@' && sv.name[0] != '#')
802         lose ((ME, _("%s: position %d: Variable name begins with invalid "
803                "character."), h->fn, i));
804       if (islower ((unsigned char) sv.name[0]))
805         msg (MW, _("%s: position %d: Variable name begins with lowercase letter "
806              "%c."), h->fn, i, sv.name[0]);
807       if (sv.name[0] == '#')
808         msg (MW, _("%s: position %d: Variable name begins with octothorpe "
809                    "(`#').  Scratch variables should not appear in system "
810                    "files."), h->fn, i);
811       vv->name[0] = toupper ((unsigned char) (sv.name[0]));
812
813       /* Copy remaining characters of variable name. */
814       for (j = 1; j < 8; j++)
815         {
816           int c = (unsigned char) sv.name[j];
817
818           if (isspace (c))
819             break;
820           else if (islower (c))
821             {
822               msg (MW, _("%s: position %d: Variable name character %d is "
823                    "lowercase letter %c."), h->fn, i, j + 1, sv.name[j]);
824               vv->name[j] = toupper ((unsigned char) (c));
825             }
826           else if (isalnum (c) || c == '.' || c == '@'
827                    || c == '#' || c == '$' || c == '_')
828             vv->name[j] = c;
829           else
830             lose ((ME, _("%s: position %d: character `\\%03o' (%c) is not valid in a "
831                    "variable name."), h->fn, i, c, c));
832         }
833       vv->name[j] = 0;
834
835       /* Set type, width, and `left' fields and allocate `value'
836          indices. */
837       if (sv.type == 0)
838         {
839           vv->type = NUMERIC;
840           vv->width = 0;
841           vv->get.nv = 1;
842           vv->get.fv = next_value++;
843           vv->nv = 1;
844         }
845       else
846         {
847           vv->type = ALPHA;
848           vv->width = sv.type;
849           vv->nv = DIV_RND_UP (vv->width, MAX_SHORT_STRING);
850           vv->get.nv = DIV_RND_UP (vv->width, sizeof (flt64));
851           vv->get.fv = next_value;
852           next_value += vv->get.nv;
853           long_string_count = vv->get.nv - 1;
854         }
855       vv->left = (vv->name[0] == '#');
856
857       /* Get variable label, if any. */
858       if (sv.has_var_label == 1)
859         {
860           /* Disk buffer. */
861           int32 len;
862
863           /* Read length of label. */
864           assertive_bufread (h, &len, sizeof len, 0);
865           if (ext->reverse_endian)
866             bswap_int32 (&len);
867
868           /* Check len. */
869           if (len < 0 || len > 255)
870             lose ((ME, _("%s: Variable %s indicates variable label of invalid "
871                    "length %d."), h->fn, vv->name, len));
872
873           /* Read label into variable structure. */
874           vv->label = bufread (h, NULL, ROUND_UP (len, sizeof (int32)), len + 1);
875           if (vv->label == NULL)
876             goto lossage;
877           vv->label[len] = '\0';
878         }
879
880       /* Set missing values. */
881       if (sv.n_missing_values != 0)
882         {
883           flt64 mv[3];
884
885           if (vv->width > MAX_SHORT_STRING)
886             lose ((ME, _("%s: Long string variable %s may not have missing "
887                    "values."), h->fn, vv->name));
888
889           assertive_bufread (h, mv, sizeof *mv * abs (sv.n_missing_values), 0);
890
891           if (ext->reverse_endian && vv->type == NUMERIC)
892             for (j = 0; j < abs (sv.n_missing_values); j++)
893               bswap_flt64 (&mv[j]);
894
895           if (sv.n_missing_values > 0)
896             {
897               vv->miss_type = sv.n_missing_values;
898               if (vv->type == NUMERIC)
899                 for (j = 0; j < sv.n_missing_values; j++)
900                   vv->missing[j].f = mv[j];
901               else
902                 for (j = 0; j < sv.n_missing_values; j++)
903                   memcpy (vv->missing[j].s, &mv[j], vv->width);
904             }
905           else
906             {
907               int x = 0;
908
909               if (vv->type == ALPHA)
910                 lose ((ME, _("%s: String variable %s may not have missing "
911                        "values specified as a range."), h->fn, vv->name));
912
913               if (mv[0] == ext->lowest)
914                 {
915                   vv->miss_type = MISSING_LOW;
916                   vv->missing[x++].f = mv[1];
917                 }
918               else if (mv[1] == ext->highest)
919                 {
920                   vv->miss_type = MISSING_HIGH;
921                   vv->missing[x++].f = mv[0];
922                 }
923               else
924                 {
925                   vv->miss_type = MISSING_RANGE;
926                   vv->missing[x++].f = mv[0];
927                   vv->missing[x++].f = mv[1];
928                 }
929
930               if (sv.n_missing_values == -3)
931                 {
932                   vv->miss_type += 3;
933                   vv->missing[x++].f = mv[2];
934                 }
935             }
936         }
937       else
938         vv->miss_type = MISSING_NONE;
939
940       if (!parse_format_spec (h, sv.print, &vv->print, vv)
941           || !parse_format_spec (h, sv.write, &vv->write, vv))
942         goto lossage;
943     }
944
945   /* Some consistency checks. */
946   if (long_string_count != 0)
947     lose ((ME, _("%s: Long string continuation records omitted at end of "
948            "dictionary."), h->fn));
949   if (next_value != ext->case_size)
950     lose ((ME, _("%s: System file header indicates %d variable positions but "
951            "%d were read from file."), h->fn, ext->case_size, next_value));
952   dict->var = xrealloc (dict->var, sizeof *dict->var * dict->nvar);
953
954   /* Construct AVL tree of dictionary in order to speed up later
955      processing and to check for duplicate varnames. */
956   dict->var_by_name = avl_create (NULL, cmp_variable, NULL);
957   for (i = 0; i < dict->nvar; i++)
958     if (NULL != avl_insert (dict->var_by_name, dict->var[i]))
959       lose ((ME, _("%s: Duplicate variable name `%s' within system file."),
960              h->fn, dict->var[i]->name));
961
962   return 1;
963
964 lossage:
965   for (i = 0; i < dict->nvar; i++)
966     {
967       free (dict->var[i]->label);
968       free (dict->var[i]);
969     }
970   free (dict->var);
971   if (dict->var_by_name)
972     avl_destroy (dict->var_by_name, NULL);
973   free (dict);
974   ext->dict = NULL;
975
976   return 0;
977 }
978
979 /* Translates the format spec from sysfile format to internal
980    format. */
981 static int
982 parse_format_spec (struct file_handle *h, int32 s, struct fmt_spec *v, struct variable *vv)
983 {
984   if ((size_t) ((s >> 16) & 0xff)
985       >= sizeof translate_fmt / sizeof *translate_fmt)
986     lose ((ME, _("%s: Bad format specifier byte (%d)."),
987            h->fn, (s >> 16) & 0xff));
988   
989   v->type = translate_fmt[(s >> 16) & 0xff];
990   v->w = (s >> 8) & 0xff;
991   v->d = s & 0xff;
992
993   /* FIXME?  Should verify the resulting specifier more thoroughly. */
994
995   if (v->type == -1)
996     lose ((ME, _("%s: Bad format specifier byte (%d)."),
997            h->fn, (s >> 16) & 0xff));
998   if ((vv->type == ALPHA) ^ ((formats[v->type].cat & FCAT_STRING) != 0))
999     lose ((ME, _("%s: %s variable %s has %s format specifier %s."),
1000            h->fn, vv->type == ALPHA ? _("String") : _("Numeric"),
1001            vv->name,
1002            formats[v->type].cat & FCAT_STRING ? _("string") : _("numeric"),
1003            formats[v->type].name));
1004   return 1;
1005
1006 lossage:
1007   return 0;
1008 }
1009
1010 /* Reads value labels from sysfile H and inserts them into the
1011    associated dictionary. */
1012 int
1013 read_value_labels (struct file_handle * h, struct variable ** var_by_index)
1014 {
1015   struct sfm_fhuser_ext *ext = h->ext;  /* File extension record. */
1016
1017   flt64 *raw_label = NULL;      /* Array of raw label values. */
1018   struct value_label **cooked_label = NULL;     /* Array of cooked labels. */
1019   int32 n_labels;               /* Number of labels. */
1020
1021   struct variable **var = NULL; /* Associated variables. */
1022   int32 n_vars;                 /* Number of associated variables. */
1023
1024   int i;
1025
1026   /* First step: read the contents of the type 3 record and record its
1027      contents.  Note that we can't do much with the data since we
1028      don't know yet whether it is of numeric or string type. */
1029
1030   /* Read number of labels. */
1031   assertive_bufread (h, &n_labels, sizeof n_labels, 0);
1032   if (ext->reverse_endian)
1033     bswap_int32 (&n_labels);
1034
1035   /* Allocate memory. */
1036   raw_label = xmalloc (sizeof *raw_label * n_labels);
1037   cooked_label = xmalloc (sizeof *cooked_label * n_labels);
1038   for (i = 0; i < n_labels; i++)
1039     cooked_label[i] = NULL;
1040
1041   /* Read each value/label tuple. */
1042   for (i = 0; i < n_labels; i++)
1043     {
1044       flt64 value;
1045       unsigned char label_len;
1046
1047       int rem;
1048
1049       /* Read value, label length. */
1050       assertive_bufread (h, &value, sizeof value, 0);
1051       assertive_bufread (h, &label_len, 1, 0);
1052       memcpy (&raw_label[i], &value, sizeof value);
1053
1054       /* Read label. */
1055       cooked_label[i] = xmalloc (sizeof **cooked_label);
1056       cooked_label[i]->s = xmalloc (label_len + 1);
1057       assertive_bufread (h, cooked_label[i]->s, label_len, 0);
1058       cooked_label[i]->s[label_len] = 0;
1059
1060       /* Skip padding. */
1061       rem = REM_RND_UP (label_len + 1, sizeof (flt64));
1062       if (rem)
1063         assertive_bufread (h, &value, rem, 0);
1064     }
1065
1066   /* Second step: Read the type 4 record that has the list of
1067      variables to which the value labels are to be applied. */
1068
1069   /* Read record type of type 4 record. */
1070   {
1071     int32 rec_type;
1072     
1073     assertive_bufread (h, &rec_type, sizeof rec_type, 0);
1074     if (ext->reverse_endian)
1075       bswap_int32 (&rec_type);
1076     
1077     if (rec_type != 4)
1078       lose ((ME, _("%s: Variable index record (type 4) does not immediately "
1079              "follow value label record (type 3) as it ought."), h->fn));
1080   }
1081
1082   /* Read number of variables associated with value label from type 4
1083      record. */
1084   assertive_bufread (h, &n_vars, sizeof n_vars, 0);
1085   if (ext->reverse_endian)
1086     bswap_int32 (&n_vars);
1087   if (n_vars < 1 || n_vars > ext->dict->nvar)
1088     lose ((ME, _("%s: Number of variables associated with a value label (%d) "
1089            "is not between 1 and the number of variables (%d)."),
1090            h->fn, n_vars, ext->dict->nvar));
1091
1092   /* Allocate storage. */
1093   var = xmalloc (sizeof *var * n_vars);
1094
1095   /* Read the list of variables. */
1096   for (i = 0; i < n_vars; i++)
1097     {
1098       int32 var_index;
1099       struct variable *v;
1100
1101       /* Read variable index, check range. */
1102       assertive_bufread (h, &var_index, sizeof var_index, 0);
1103       if (ext->reverse_endian)
1104         bswap_int32 (&var_index);
1105       if (var_index < 1 || var_index > ext->case_size)
1106         lose ((ME, _("%s: Variable index associated with value label (%d) is "
1107                "not between 1 and the number of values (%d)."),
1108                h->fn, var_index, ext->case_size));
1109
1110       /* Make sure it's a real variable. */
1111       v = var_by_index[var_index - 1];
1112       if (v == NULL)
1113         lose ((ME, _("%s: Variable index associated with value label (%d) refers "
1114                "to a continuation of a string variable, not to an actual "
1115                "variable."), h->fn, var_index));
1116       if (v->type == ALPHA && v->width > MAX_SHORT_STRING)
1117         lose ((ME, _("%s: Value labels are not allowed on long string variables "
1118                "(%s)."), h->fn, v->name));
1119
1120       /* Add it to the list of variables. */
1121       var[i] = v;
1122     }
1123
1124   /* Type check the variables. */
1125   for (i = 1; i < n_vars; i++)
1126     if (var[i]->type != var[0]->type)
1127       lose ((ME, _("%s: Variables associated with value label are not all of "
1128              "identical type.  Variable %s has %s type, but variable %s has "
1129              "%s type."), h->fn,
1130              var[0]->name, var[0]->type == ALPHA ? _("string") : _("numeric"),
1131              var[i]->name, var[i]->type == ALPHA ? _("string") : _("numeric")));
1132
1133   /* Create a value_label for each value/label tuple, now that we know
1134      the desired type. */
1135   for (i = 0; i < n_labels; i++)
1136     {
1137       if (var[0]->type == ALPHA)
1138         {
1139           const int copy_len = min (sizeof (flt64), MAX_SHORT_STRING);
1140           memcpy (cooked_label[i]->v.s, (char *) &raw_label[i], copy_len);
1141           if (MAX_SHORT_STRING > copy_len)
1142             memset (&cooked_label[i]->v.s[copy_len], ' ',
1143                     MAX_SHORT_STRING - copy_len);
1144         } else {
1145           cooked_label[i]->v.f = raw_label[i];
1146           if (ext->reverse_endian)
1147             bswap_flt64 (&cooked_label[i]->v.f);
1148         }
1149       cooked_label[i]->ref_count = n_vars;
1150     }
1151
1152   /* Assign the value_label's to each variable. */
1153   for (i = 0; i < n_vars; i++)
1154     {
1155       struct variable *v = var[i];
1156       int j;
1157
1158       /* Create AVL tree if necessary. */
1159       if (!v->val_lab)
1160         v->val_lab = avl_create (NULL, val_lab_cmp, (void *) (v->width));
1161
1162       /* Add each label to the variable. */
1163       for (j = 0; j < n_labels; j++)
1164         {
1165           struct value_label *old = avl_replace (v->val_lab, cooked_label[j]);
1166           if (old == NULL)
1167             continue;
1168
1169           if (var[0]->type == NUMERIC)
1170             msg (MW, _("%s: File contains duplicate label for value %g for "
1171                  "variable %s."), h->fn, cooked_label[j]->v.f, v->name);
1172           else
1173             msg (MW, _("%s: File contains duplicate label for value `%.*s' "
1174                  "for variable %s."), h->fn, v->width,
1175                  cooked_label[j]->v.s, v->name);
1176
1177           free_value_label (old);
1178         }
1179     }
1180
1181   free (cooked_label);
1182   free (raw_label);
1183   free (var);
1184   return 1;
1185
1186 lossage:
1187   if (cooked_label)
1188     for (i = 0; i < n_labels; i++)
1189       if (cooked_label[i])
1190         {
1191           free (cooked_label[i]->s);
1192           free (cooked_label[i]);
1193         }
1194   free (raw_label);
1195   free (var);
1196   return 0;
1197 }
1198
1199 /* Reads NBYTES bytes from the file represented by H.  If BUF is
1200    non-NULL, uses that as the buffer; otherwise allocates at least
1201    MINALLOC bytes.  Returns a pointer to the buffer on success, NULL
1202    on failure. */
1203 static void *
1204 bufread (struct file_handle * h, void *buf, size_t nbytes, size_t minalloc)
1205 {
1206   struct sfm_fhuser_ext *ext = h->ext;
1207
1208   if (buf == NULL)
1209     buf = xmalloc (max (nbytes, minalloc));
1210   if (1 != fread (buf, nbytes, 1, ext->file))
1211     {
1212       if (ferror (ext->file))
1213         msg (ME, _("%s: Reading system file: %s."), h->fn, strerror (errno));
1214       else
1215         corrupt_msg (ME, _("%s: Unexpected end of file."), h->fn);
1216       return NULL;
1217     }
1218   return buf;
1219 }
1220
1221 /* Reads a document record, type 6, from system file H, and sets up
1222    the documents and n_documents fields in the associated
1223    dictionary. */
1224 static int
1225 read_documents (struct file_handle * h)
1226 {
1227   struct sfm_fhuser_ext *ext = h->ext;
1228   struct dictionary *dict = ext->dict;
1229   int32 n_lines;
1230
1231   if (dict->documents != NULL)
1232     lose ((ME, _("%s: System file contains multiple type 6 (document) records."),
1233            h->fn));
1234
1235   assertive_bufread (h, &n_lines, sizeof n_lines, 0);
1236   dict->n_documents = n_lines;
1237   if (dict->n_documents <= 0)
1238     lose ((ME, _("%s: Number of document lines (%ld) must be greater than 0."),
1239            h->fn, (long) dict->n_documents));
1240
1241   dict->documents = bufread (h, NULL, 80 * n_lines, 0);
1242   if (dict->documents == NULL)
1243     return 0;
1244   return 1;
1245
1246 lossage:
1247   return 0;
1248 }
1249
1250 #if GLOBAL_DEBUGGING
1251 #include "debug-print.h"
1252 /* Displays dictionary DICT on stdout. */
1253 void
1254 dump_dictionary (struct dictionary * dict)
1255 {
1256   int i;
1257
1258   debug_printf ((_("dictionary:\n")));
1259   for (i = 0; i < dict->nvar; i++)
1260     {
1261       char print[32];
1262       struct variable *v = dict->var[i];
1263       int n, j;
1264
1265       debug_printf (("   var %s", v->name));
1266       /*debug_printf (("(indices:%d,%d)", v->index, v->foo));*/
1267       debug_printf (("(type:%s,%d)", (v->type == NUMERIC ? _("num")
1268                                  : (v->type == ALPHA ? _("str") : "!!!")),
1269                      v->width));
1270       debug_printf (("(fv:%d,%d)", v->fv, v->nv));
1271       /*debug_printf (("(get.fv:%d,%d)", v->get.fv, v->get.nv));*/
1272       debug_printf (("(left:%s)(miss:", v->left ? _("left") : _("right")));
1273               
1274       switch (v->miss_type)
1275         {
1276         case MISSING_NONE:
1277           n = 0;
1278           debug_printf ((_("none")));
1279           break;
1280         case MISSING_1:
1281           n = 1;
1282           debug_printf ((_("one")));
1283           break;
1284         case MISSING_2:
1285           n = 2;
1286           debug_printf ((_("two")));
1287           break;
1288         case MISSING_3:
1289           n = 3;
1290           debug_printf ((_("three")));
1291           break;
1292         case MISSING_RANGE:
1293           n = 2;
1294           debug_printf ((_("range")));
1295           break;
1296         case MISSING_LOW:
1297           n = 1;
1298           debug_printf ((_("low")));
1299           break;
1300         case MISSING_HIGH:
1301           n = 1;
1302           debug_printf ((_("high")));
1303           break;
1304         case MISSING_RANGE_1:
1305           n = 3;
1306           debug_printf ((_("range+1")));
1307           break;
1308         case MISSING_LOW_1:
1309           n = 2;
1310           debug_printf ((_("low+1")));
1311           break;
1312         case MISSING_HIGH_1:
1313           n = 2;
1314           debug_printf ((_("high+1")));
1315           break;
1316         default:
1317           assert (0);
1318         }
1319       for (j = 0; j < n; j++)
1320         if (v->type == NUMERIC)
1321           debug_printf ((",%g", v->missing[j].f));
1322         else
1323           debug_printf ((",\"%.*s\"", v->width, v->missing[j].s));
1324       strcpy (print, fmt_to_string (&v->print));
1325       debug_printf ((")(fmt:%s,%s)(lbl:%s)\n",
1326                      print, fmt_to_string (&v->write),
1327                      v->label ? v->label : "nolabel"));
1328     }
1329 }
1330 #endif
1331 \f
1332 /* Data reader. */
1333
1334 /* Reads compressed data into H->BUF and sets other pointers
1335    appropriately.  Returns nonzero only if both no errors occur and
1336    data was read. */
1337 static int
1338 buffer_input (struct file_handle * h)
1339 {
1340   struct sfm_fhuser_ext *ext = h->ext;
1341   size_t amt;
1342
1343   if (ext->buf == NULL)
1344     ext->buf = xmalloc (sizeof *ext->buf * 128);
1345   amt = fread (ext->buf, sizeof *ext->buf, 128, ext->file);
1346   if (ferror (ext->file))
1347     {
1348       msg (ME, _("%s: Error reading file: %s."), h->fn, strerror (errno));
1349       return 0;
1350     }
1351   ext->ptr = ext->buf;
1352   ext->end = &ext->buf[amt];
1353   return amt;
1354 }
1355
1356 /* Reads a single case consisting of compressed data from system file
1357    H into the array TEMP[] according to dictionary DICT, and returns
1358    nonzero only if successful. */
1359 /* Data in system files is compressed in the following manner:
1360    data values are grouped into sets of eight; each of the eight has
1361    one instruction byte, which are output together in an octet; each
1362    byte gives a value for that byte or indicates that the value can be
1363    found following the instructions. */
1364 static int
1365 read_compressed_data (struct file_handle * h, flt64 * temp)
1366 {
1367   struct sfm_fhuser_ext *ext = h->ext;
1368
1369   const unsigned char *p_end = ext->x + sizeof (flt64);
1370   unsigned char *p = ext->y;
1371
1372   const flt64 *temp_beg = temp;
1373   const flt64 *temp_end = &temp[ext->case_size];
1374
1375   for (;;)
1376     {
1377       for (; p < p_end; p++)
1378         switch (*p)
1379           {
1380           case 0:
1381             /* Code 0 is ignored. */
1382             continue;
1383           case 252:
1384             /* Code 252 is end of file. */
1385             if (temp_beg != temp)
1386               lose ((ME, _("%s: Compressed data is corrupted.  Data ends "
1387                      "partway through a case."), h->fn));
1388             goto lossage;
1389           case 253:
1390             /* Code 253 indicates that the value is stored explicitly
1391                following the instruction bytes. */
1392             if (ext->ptr == NULL || ext->ptr >= ext->end)
1393               if (!buffer_input (h))
1394                 {
1395                   lose ((ME, _("%s: Unexpected end of file."), h->fn));
1396                   goto lossage;
1397                 }
1398             memcpy (temp++, ext->ptr++, sizeof *temp);
1399             if (temp >= temp_end)
1400               goto winnage;
1401             break;
1402           case 254:
1403             /* Code 254 indicates a string that is all blanks. */
1404             memset (temp++, ' ', sizeof *temp);
1405             if (temp >= temp_end)
1406               goto winnage;
1407             break;
1408           case 255:
1409             /* Code 255 indicates the system-missing value. */
1410             *temp = ext->sysmis;
1411             if (ext->reverse_endian)
1412               bswap_flt64 (temp);
1413             temp++;
1414             if (temp >= temp_end)
1415               goto winnage;
1416             break;
1417           default:
1418             /* Codes 1 through 251 inclusive are taken to indicate a
1419                value of (BYTE - BIAS), where BYTE is the byte's value
1420                and BIAS is the compression bias (generally 100.0). */
1421             *temp = *p - ext->bias;
1422             if (ext->reverse_endian)
1423               bswap_flt64 (temp);
1424             temp++;
1425             if (temp >= temp_end)
1426               goto winnage;
1427             break;
1428           }
1429
1430       /* We have reached the end of this instruction octet.  Read
1431          another. */
1432       if (ext->ptr == NULL || ext->ptr >= ext->end)
1433         if (!buffer_input (h))
1434           {
1435             if (temp_beg != temp)
1436               lose ((ME, _("%s: Unexpected end of file."), h->fn));
1437             goto lossage;
1438           }
1439       memcpy (ext->x, ext->ptr++, sizeof *temp);
1440       p = ext->x;
1441     }
1442
1443   /* Not reached. */
1444   assert (0);
1445
1446 winnage:
1447   /* We have filled up an entire record.  Update state and return
1448      successfully. */
1449   ext->y = ++p;
1450   return 1;
1451
1452 lossage:
1453   /* We have been unsuccessful at filling a record, either through i/o
1454      error or through an end-of-file indication.  Update state and
1455      return unsuccessfully. */
1456   return 0;
1457 }
1458
1459 /* Reads one case from system file H into the value array PERM
1460    according to the instructions given in associated dictionary DICT,
1461    which must have the get.* elements appropriately set.  Returns
1462    nonzero only if successful.  */
1463 int
1464 sfm_read_case (struct file_handle * h, union value * perm, struct dictionary * dict)
1465 {
1466   struct sfm_fhuser_ext *ext = h->ext;
1467
1468   size_t nbytes;
1469   flt64 *temp;
1470
1471   int i;
1472
1473   /* Make sure the caller remembered to finish polishing the
1474      dictionary returned by sfm_read_dictionary(). */
1475   assert (dict->nval > 0);
1476
1477   /* The first concern is to obtain a full case relative to the data
1478      file.  (Cases in the data file have no particular relationship to
1479      cases in the active file.) */
1480   nbytes = sizeof *temp * ext->case_size;
1481   temp = local_alloc (nbytes);
1482
1483   if (ext->compressed == 0)
1484     {
1485       size_t amt = fread (temp, 1, nbytes, ext->file);
1486
1487       if (amt != nbytes)
1488         {
1489           if (ferror (ext->file))
1490             msg (ME, _("%s: Reading system file: %s."), h->fn, strerror (errno));
1491           else if (amt != 0)
1492             msg (ME, _("%s: Partial record at end of system file."), h->fn);
1493           goto lossage;
1494         }
1495     }
1496   else if (!read_compressed_data (h, temp))
1497     goto lossage;
1498
1499   /* Translate a case in data file format to a case in active file
1500      format. */
1501   for (i = 0; i < dict->nvar; i++)
1502     {
1503       struct variable *v = dict->var[i];
1504
1505       if (v->get.fv == -1)
1506         continue;
1507       
1508       if (v->type == NUMERIC)
1509         {
1510           flt64 src = temp[v->get.fv];
1511           if (ext->reverse_endian)
1512             bswap_flt64 (&src);
1513           perm[v->fv].f = src == ext->sysmis ? SYSMIS : src;
1514         }
1515       else
1516         memcpy (&perm[v->fv].s, &temp[v->get.fv], v->width);
1517     }
1518
1519   local_free (temp);
1520   return 1;
1521
1522 lossage:
1523   local_free (temp);
1524   return 0;
1525 }
1526
1527 static struct fh_ext_class sfm_r_class =
1528 {
1529   3,
1530   N_("reading as a system file"),
1531   sfm_close,
1532 };