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 "format.h"
  48 #include "getline.h"
  49 #include "magic.h"
  50 #include "misc.h"
  51 #include "sfm.h"
  52 #include "sfmP.h"
  53 #include "str.h"
  54 #include "var.h"
  55
  56 #undef DEBUGGING
  57 /*#define DEBUGGING 1*/
  58 #include "debug-print.h"
  59
  60 /* PORTME: This file may require substantial revision for those
  61    systems that don't meet the typical 32-bit integer/64-bit double
  62    model.  It's kinda hard to tell without having one of them on my
  63    desk.  */
  64
  65 /* sfm's file_handle extension. */
  66 struct sfm_fhuser_ext
  67   {
  68     FILE *file;                 /* Actual file. */
  69     int opened;                 /* Reference count. */
  70
  71     struct dictionary *dict;    /* File's dictionary. */
  72
  73     int reverse_endian;         /* 1=file has endianness opposite us. */
  74     int case_size;              /* Number of `values's per case. */
  75     long ncases;                /* Number of cases, -1 if unknown. */
  76     int compressed;             /* 1=compressed, 0=not compressed. */
  77     double bias;                /* Compression bias, usually 100.0. */
  78     int weight_index;           /* 0-based index of weighting variable, or -1. */
  79
  80     /* File's special constants. */
  81     flt64 sysmis;
  82     flt64 highest;
  83     flt64 lowest;
  84
  85     /* Uncompression buffer. */
  86     flt64 *buf;                 /* Buffer data. */
  87     flt64 *ptr;                 /* Current location in buffer. */
  88     flt64 *end;                 /* End of buffer data. */
  89
  90     /* Compression instruction octet. */
  91     unsigned char x[sizeof (flt64)];
  92     /* Current instruction octet. */
  93     unsigned char *y;           /* Location in current instruction octet. */
  94   };
  95
  96 static struct fh_ext_class sfm_r_class;
  97
  98 #if GLOBAL_DEBUGGING
  99 void dump_dictionary (struct dictionary * dict);
 100 #endif
 101 \f
 102 /* Utilities. */
 103
 104 /* bswap_int32(): Reverse the byte order of 32-bit integer *X. */
 105 #if __linux__
 106 #include <asm/byteorder.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 == fclose (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 = fopen (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   fclose (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_endian;
 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   switch (FPREP)
 482     {
 483     case FPREP_IEEE754:
 484       if (data[4] != 1)
 485         lose ((ME, _("%s: Floating-point representation in system file is not "
 486                "IEEE-754.  PSPP cannot convert between floating-point "
 487                "formats."), h->fn));
 488       break;
 489     default:
 490       assert (0);
 491     }
 492
 493   /* PORTME: Check recorded file endianness against intuited file
 494      endianness. */
 495   file_endian = endian;
 496   if (ext->reverse_endian)
 497     {
 498       if (file_endian == BIG)
 499         file_endian = LITTLE;
 500       else if (file_endian == LITTLE)
 501         file_endian = BIG;
 502       else
 503         assert (0);
 504     }
 505   if ((file_endian == BIG) ^ (data[6] == 1))
 506     lose ((ME, _("%s: File-indicated endianness (%s) does not match endianness "
 507            "intuited from file header (%s)."),
 508            h->fn, file_endian == BIG ? _("big-endian") : _("little-endian"),
 509            data[6] == 1 ? _("big-endian") : (data[6] == 2 ? _("little-endian")
 510                                           : _("unknown"))));
 511
 512   /* PORTME: Character representation code. */
 513   if (data[7] != 2 && data[7] != 3)
 514     lose ((ME, _("%s: File-indicated character representation code (%s) is not "
 515            "ASCII."), h->fn,
 516        data[7] == 1 ? "EBCDIC" : (data[7] == 4 ? _("DEC Kanji") : _("Unknown"))));
 517
 518   return 1;
 519
 520 lossage:
 521   return 0;
 522 }
 523
 524 /* Read record type 7, subtype 4. */
 525 static int
 526 read_machine_flt64_info (struct file_handle * h, int size, int count)
 527 {
 528   struct sfm_fhuser_ext *ext = h->ext;
 529
 530   flt64 data[3];
 531
 532   int i;
 533
 534   if (size != sizeof (flt64) || count != 3)
 535     lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
 536            "subtype 4.  Expected size %d, count 8."),
 537            h->fn, size, count, sizeof (flt64)));
 538
 539   assertive_bufread (h, data, sizeof data, 0);
 540   if (ext->reverse_endian)
 541     for (i = 0; i < 3; i++)
 542       bswap_flt64 (&data[i]);
 543
 544   if (data[0] != SYSMIS || data[1] != FLT64_MAX
 545       || data[2] != second_lowest_flt64)
 546     {
 547       ext->sysmis = data[0];
 548       ext->highest = data[1];
 549       ext->lowest = data[2];
 550       msg (MW, _("%s: File-indicated value is different from internal value "
 551                  "for at least one of the three system values.  SYSMIS: "
 552                  "indicated %g, expected %g; HIGHEST: %g, %g; LOWEST: "
 553                  "%g, %g."),
 554            h->fn, (double) data[0], (double) SYSMIS,
 555            (double) data[1], (double) FLT64_MAX,
 556            (double) data[2], (double) second_lowest_flt64);
 557     }
 558
 559   return 1;
 560
 561 lossage:
 562   return 0;
 563 }
 564
 565 static int
 566 read_header (struct file_handle * h, struct sfm_read_info * inf)
 567 {
 568   struct sfm_fhuser_ext *ext = h->ext;  /* File extension strcut. */
 569   struct sysfile_header hdr;            /* Disk buffer. */
 570   struct dictionary *dict;              /* File dictionary. */
 571   char prod_name[sizeof hdr.prod_name + 1];     /* Buffer for product name. */
 572   int skip_amt;                 /* Amount of product name to omit. */
 573   int i;
 574
 575   /* Create the dictionary. */
 576   dict = ext->dict = xmalloc (sizeof *dict);
 577   dict->var = NULL;
 578   dict->var_by_name = NULL;
 579   dict->nvar = 0;
 580   dict->N = 0;
 581   dict->nval = -1;              /* Unknown. */
 582   dict->n_splits = 0;
 583   dict->splits = NULL;
 584   dict->weight_var[0] = 0;
 585   dict->weight_index = -1;
 586   dict->filter_var[0] = 0;
 587   dict->label = NULL;
 588   dict->n_documents = 0;
 589   dict->documents = NULL;
 590
 591   /* Read header, check magic. */
 592   assertive_bufread (h, &hdr, sizeof hdr, 0);
 593   if (0 != strncmp ("$FL2", hdr.rec_type, 4))
 594     lose ((ME, _("%s: Bad magic.  Proper system files begin with "
 595                  "the four characters `$FL2'. This file will not be read."),
 596            h->fn));
 597
 598   /* Check eye-catcher string. */
 599   memcpy (prod_name, hdr.prod_name, sizeof hdr.prod_name);
 600   for (i = 0; i < 60; i++)
 601     if (!isprint ((unsigned char) prod_name[i]))
 602       prod_name[i] = ' ';
 603   for (i = 59; i >= 0; i--)
 604     if (!isgraph ((unsigned char) prod_name[i]))
 605       {
 606         prod_name[i] = '\0';
 607         break;
 608       }
 609   prod_name[60] = '\0';
 610
 611   {
 612 #define N_PREFIXES 2
 613     static const char *prefix[N_PREFIXES] =
 614       {
 615         "@(#) SPSS DATA FILE",
 616         "SPSS SYSTEM FILE.",
 617       };
 618
 619     int i;
 620
 621     for (i = 0; i < N_PREFIXES; i++)
 622       if (!strncmp (prefix[i], hdr.prod_name, strlen (prefix[i])))
 623         {
 624           skip_amt = strlen (prefix[i]);
 625           break;
 626         }
 627   }
 628
 629   /* Check endianness. */
 630   /* PORTME: endianness. */
 631   if (hdr.layout_code == 2)
 632     ext->reverse_endian = 0;
 633   else
 634     {
 635       bswap_int32 (&hdr.layout_code);
 636       if (hdr.layout_code != 2)
 637         lose ((ME, _("%s: File layout code has unexpected value %d.  Value "
 638                "should be 2, in big-endian or little-endian format."),
 639                h->fn, hdr.layout_code));
 640
 641       ext->reverse_endian = 1;
 642       bswap_int32 (&hdr.case_size);
 643       bswap_int32 (&hdr.compressed);
 644       bswap_int32 (&hdr.weight_index);
 645       bswap_int32 (&hdr.ncases);
 646       bswap_flt64 (&hdr.bias);
 647     }
 648
 649   /* Copy basic info and verify correctness. */
 650   ext->case_size = hdr.case_size;
 651   if (hdr.case_size <= 0 || ext->case_size > (INT_MAX
 652                                               / (int) sizeof (union value) / 2))
 653     lose ((ME, _("%s: Number of elements per case (%d) is not between 1 "
 654            "and %d."), h->fn, hdr.case_size, INT_MAX / sizeof (union value) / 2));
 655
 656   ext->compressed = hdr.compressed;
 657
 658   ext->weight_index = hdr.weight_index - 1;
 659   if (hdr.weight_index < 0 || hdr.weight_index > hdr.case_size)
 660     lose ((ME, _("%s: Index of weighting variable (%d) is not between 0 "
 661            "and number of elements per case (%d)."),
 662            h->fn, hdr.weight_index, ext->case_size));
 663
 664   ext->ncases = hdr.ncases;
 665   if (ext->ncases < -1 || ext->ncases > INT_MAX / 2)
 666     lose ((ME, _("%s: Number of cases in file (%ld) is not between -1 and "
 667            "%d."), h->fn, (long) ext->ncases, INT_MAX / 2));
 668
 669   ext->bias = hdr.bias;
 670   if (ext->bias != 100.0)
 671     corrupt_msg (MW, _("%s: Compression bias (%g) is not the usual "
 672                  "value of 100."), h->fn, ext->bias);
 673
 674   /* Make a file label only on the condition that the given label is
 675      not all spaces or nulls. */
 676   {
 677     int i;
 678
 679     dict->label = NULL;
 680     for (i = sizeof hdr.file_label - 1; i >= 0; i--)
 681       if (!isspace ((unsigned char) hdr.file_label[i])
 682           && hdr.file_label[i] != 0)
 683         {
 684           dict->label = xmalloc (i + 2);
 685           memcpy (dict->label, hdr.file_label, i + 1);
 686           dict->label[i + 1] = 0;
 687           break;
 688         }
 689   }
 690
 691   if (inf)
 692     {
 693       char *cp;
 694
 695       memcpy (inf->creation_date, hdr.creation_date, 9);
 696       inf->creation_date[9] = 0;
 697
 698       memcpy (inf->creation_time, hdr.creation_time, 8);
 699       inf->creation_time[8] = 0;
 700
 701       if (!ext->reverse_endian)
 702         inf->endianness = endian;
 703       else
 704         inf->endianness = endian == BIG ? LITTLE : BIG;
 705
 706       inf->compressed = hdr.compressed;
 707
 708       inf->ncases = hdr.ncases;
 709
 710       for (cp = &prod_name[skip_amt]; cp < &prod_name[60]; cp++)
 711         if (isgraph ((unsigned char) *cp))
 712           break;
 713       strcpy (inf->product, cp);
 714     }
 715
 716   return 1;
 717
 718 lossage:
 719   return 0;
 720 }
 721
 722 /* Reads most of the dictionary from file H; also fills in the
 723    associated VAR_BY_INDEX array.
 724
 725    Note: the dictionary returned by this function has an invalid NVAL
 726    element, also the VAR[] array does not have the FV and LV elements
 727    set, however the NV elements *are* set.  This is because the caller
 728    will probably modify the dictionary before reading it in from the
 729    file.  Also, the get.* elements are set to appropriate values to
 730    allow the file to be read.  */
 731 static int
 732 read_variables (struct file_handle * h, struct variable *** var_by_index)
 733 {
 734   int i;
 735
 736   struct sfm_fhuser_ext *ext = h->ext;  /* File extension record. */
 737   struct dictionary *dict = ext->dict;  /* Dictionary being constructed. */
 738   struct sysfile_variable sv;           /* Disk buffer. */
 739   int long_string_count = 0;    /* # of long string continuation
 740                                    records still expected. */
 741   int next_value = 0;           /* Index to next `value' structure. */
 742
 743   /* Allocate variables. */
 744   dict->var = xmalloc (sizeof *dict->var * ext->case_size);
 745   *var_by_index = xmalloc (sizeof **var_by_index * ext->case_size);
 746
 747   /* Read in the entry for each variable and use the info to
 748      initialize the dictionary. */
 749   for (i = 0; i < ext->case_size; i++)
 750     {
 751       struct variable *vv;
 752       int j;
 753
 754       assertive_bufread (h, &sv, sizeof sv, 0);
 755
 756       if (ext->reverse_endian)
 757         {
 758           bswap_int32 (&sv.rec_type);
 759           bswap_int32 (&sv.type);
 760           bswap_int32 (&sv.has_var_label);
 761           bswap_int32 (&sv.n_missing_values);
 762           bswap_int32 (&sv.print);
 763           bswap_int32 (&sv.write);
 764         }
 765
 766       if (sv.rec_type != 2)
 767         lose ((ME, _("%s: position %d: Bad record type (%d); "
 768                "the expected value was 2."), h->fn, i, sv.rec_type));
 769
 770       /* If there was a long string previously, make sure that the
 771          continuations are present; otherwise make sure there aren't
 772          any. */
 773       if (long_string_count)
 774         {
 775           if (sv.type != -1)
 776             lose ((ME, _("%s: position %d: String variable does not have "
 777                          "proper number of continuation records."), h->fn, i));
 778
 779           (*var_by_index)[i] = NULL;
 780           long_string_count--;
 781           continue;
 782         }
 783       else if (sv.type == -1)
 784         lose ((ME, _("%s: position %d: Superfluous long string continuation "
 785                "record."), h->fn, i));
 786
 787       /* Check fields for validity. */
 788       if (sv.type < 0 || sv.type > 255)
 789         lose ((ME, _("%s: position %d: Bad variable type code %d."),
 790                h->fn, i, sv.type));
 791       if (sv.has_var_label != 0 && sv.has_var_label != 1)
 792         lose ((ME, _("%s: position %d: Variable label indicator field is not "
 793                "0 or 1."), h->fn, i));
 794       if (sv.n_missing_values < -3 || sv.n_missing_values > 3
 795           || sv.n_missing_values == -1)
 796         lose ((ME, _("%s: position %d: Missing value indicator field is not "
 797                      "-3, -2, 0, 1, 2, or 3."), h->fn, i));
 798
 799       /* Construct internal variable structure, initialize critical bits. */
 800       vv = (*var_by_index)[i] = dict->var[dict->nvar++] = xmalloc (sizeof *vv);
 801       vv->index = dict->nvar - 1;
 802       vv->foo = -1;
 803       vv->label = NULL;
 804       vv->val_lab = NULL;
 805
 806       /* Copy first character of variable name. */
 807       if (!isalpha ((unsigned char) sv.name[0])
 808           && sv.name[0] != '@' && sv.name[0] != '#')
 809         lose ((ME, _("%s: position %d: Variable name begins with invalid "
 810                "character."), h->fn, i));
 811       if (islower ((unsigned char) sv.name[0]))
 812         msg (MW, _("%s: position %d: Variable name begins with lowercase letter "
 813              "%c."), h->fn, i, sv.name[0]);
 814       if (sv.name[0] == '#')
 815         msg (MW, _("%s: position %d: Variable name begins with octothorpe "
 816                    "(`#').  Scratch variables should not appear in system "
 817                    "files."), h->fn, i);
 818       vv->name[0] = toupper ((unsigned char) (sv.name[0]));
 819
 820       /* Copy remaining characters of variable name. */
 821       for (j = 1; j < 8; j++)
 822         {
 823           int c = (unsigned char) sv.name[j];
 824
 825           if (isspace (c))
 826             break;
 827           else if (islower (c))
 828             {
 829               msg (MW, _("%s: position %d: Variable name character %d is "
 830                    "lowercase letter %c."), h->fn, i, j + 1, sv.name[j]);
 831               vv->name[j] = toupper ((unsigned char) (c));
 832             }
 833           else if (isalnum (c) || c == '.' || c == '@'
 834                    || c == '#' || c == '$' || c == '_')
 835             vv->name[j] = c;
 836           else
 837             lose ((ME, _("%s: position %d: character `\\%03o' (%c) is not valid in a "
 838                    "variable name."), h->fn, i, c, c));
 839         }
 840       vv->name[j] = 0;
 841
 842       /* Set type, width, and `left' fields and allocate `value'
 843          indices. */
 844       if (sv.type == 0)
 845         {
 846           vv->type = NUMERIC;
 847           vv->width = 0;
 848           vv->get.nv = 1;
 849           vv->get.fv = next_value++;
 850           vv->nv = 1;
 851         }
 852       else
 853         {
 854           vv->type = ALPHA;
 855           vv->width = sv.type;
 856           vv->nv = DIV_RND_UP (vv->width, MAX_SHORT_STRING);
 857           vv->get.nv = DIV_RND_UP (vv->width, sizeof (flt64));
 858           vv->get.fv = next_value;
 859           next_value += vv->get.nv;
 860           long_string_count = vv->get.nv - 1;
 861         }
 862       vv->left = (vv->name[0] == '#');
 863
 864       /* Get variable label, if any. */
 865       if (sv.has_var_label == 1)
 866         {
 867           /* Disk buffer. */
 868           int32 len;
 869
 870           /* Read length of label. */
 871           assertive_bufread (h, &len, sizeof len, 0);
 872           if (ext->reverse_endian)
 873             bswap_int32 (&len);
 874
 875           /* Check len. */
 876           if (len < 0 || len > 255)
 877             lose ((ME, _("%s: Variable %s indicates variable label of invalid "
 878                    "length %d."), h->fn, vv->name, len));
 879
 880           /* Read label into variable structure. */
 881           vv->label = bufread (h, NULL, ROUND_UP (len, sizeof (int32)), len + 1);
 882           if (vv->label == NULL)
 883             goto lossage;
 884           vv->label[len] = '\0';
 885         }
 886
 887       /* Set missing values. */
 888       if (sv.n_missing_values != 0)
 889         {
 890           flt64 mv[3];
 891
 892           if (vv->width > MAX_SHORT_STRING)
 893             lose ((ME, _("%s: Long string variable %s may not have missing "
 894                    "values."), h->fn, vv->name));
 895
 896           assertive_bufread (h, mv, sizeof *mv * abs (sv.n_missing_values), 0);
 897
 898           if (ext->reverse_endian && vv->type == NUMERIC)
 899             for (j = 0; j < abs (sv.n_missing_values); j++)
 900               bswap_flt64 (&mv[j]);
 901
 902           if (sv.n_missing_values > 0)
 903             {
 904               vv->miss_type = sv.n_missing_values;
 905               if (vv->type == NUMERIC)
 906                 for (j = 0; j < sv.n_missing_values; j++)
 907                   vv->missing[j].f = mv[j];
 908               else
 909                 for (j = 0; j < sv.n_missing_values; j++)
 910                   memcpy (vv->missing[j].s, &mv[j], vv->width);
 911             }
 912           else
 913             {
 914               int x = 0;
 915
 916               if (vv->type == ALPHA)
 917                 lose ((ME, _("%s: String variable %s may not have missing "
 918                        "values specified as a range."), h->fn, vv->name));
 919
 920               if (mv[0] == ext->lowest)
 921                 {
 922                   vv->miss_type = MISSING_LOW;
 923                   vv->missing[x++].f = mv[1];
 924                 }
 925               else if (mv[1] == ext->highest)
 926                 {
 927                   vv->miss_type = MISSING_HIGH;
 928                   vv->missing[x++].f = mv[0];
 929                 }
 930               else
 931                 {
 932                   vv->miss_type = MISSING_RANGE;
 933                   vv->missing[x++].f = mv[0];
 934                   vv->missing[x++].f = mv[1];
 935                 }
 936
 937               if (sv.n_missing_values == -3)
 938                 {
 939                   vv->miss_type += 3;
 940                   vv->missing[x++].f = mv[2];
 941                 }
 942             }
 943         }
 944       else
 945         vv->miss_type = MISSING_NONE;
 946
 947       if (!parse_format_spec (h, sv.print, &vv->print, vv)
 948           || !parse_format_spec (h, sv.write, &vv->write, vv))
 949         goto lossage;
 950     }
 951
 952   /* Some consistency checks. */
 953   if (long_string_count != 0)
 954     lose ((ME, _("%s: Long string continuation records omitted at end of "
 955            "dictionary."), h->fn));
 956   if (next_value != ext->case_size)
 957     lose ((ME, _("%s: System file header indicates %d variable positions but "
 958            "%d were read from file."), h->fn, ext->case_size, next_value));
 959   dict->var = xrealloc (dict->var, sizeof *dict->var * dict->nvar);
 960
 961   /* Construct AVL tree of dictionary in order to speed up later
 962      processing and to check for duplicate varnames. */
 963   dict->var_by_name = avl_create (NULL, cmp_variable, NULL);
 964   for (i = 0; i < dict->nvar; i++)
 965     if (NULL != avl_insert (dict->var_by_name, dict->var[i]))
 966       lose ((ME, _("%s: Duplicate variable name `%s' within system file."),
 967              h->fn, dict->var[i]->name));
 968
 969   return 1;
 970
 971 lossage:
 972   for (i = 0; i < dict->nvar; i++)
 973     {
 974       free (dict->var[i]->label);
 975       free (dict->var[i]);
 976     }
 977   free (dict->var);
 978   if (dict->var_by_name)
 979     avl_destroy (dict->var_by_name, NULL);
 980   free (dict);
 981   ext->dict = NULL;
 982
 983   return 0;
 984 }
 985
 986 /* Translates the format spec from sysfile format to internal
 987    format. */
 988 static int
 989 parse_format_spec (struct file_handle *h, int32 s, struct fmt_spec *v, struct variable *vv)
 990 {
 991   if ((size_t) ((s >> 16) & 0xff)
 992       >= sizeof translate_fmt / sizeof *translate_fmt)
 993     lose ((ME, _("%s: Bad format specifier byte (%d)."),
 994            h->fn, (s >> 16) & 0xff));
 995
 996   v->type = translate_fmt[(s >> 16) & 0xff];
 997   v->w = (s >> 8) & 0xff;
 998   v->d = s & 0xff;
 999
1000   /* FIXME?  Should verify the resulting specifier more thoroughly. */
1001
1002   if (v->type == -1)
1003     lose ((ME, _("%s: Bad format specifier byte (%d)."),
1004            h->fn, (s >> 16) & 0xff));
1005   if ((vv->type == ALPHA) ^ ((formats[v->type].cat & FCAT_STRING) != 0))
1006     lose ((ME, _("%s: %s variable %s has %s format specifier %s."),
1007            h->fn, vv->type == ALPHA ? _("String") : _("Numeric"),
1008            vv->name,
1009            formats[v->type].cat & FCAT_STRING ? _("string") : _("numeric"),
1010            formats[v->type].name));
1011   return 1;
1012
1013 lossage:
1014   return 0;
1015 }
1016
1017 /* Reads value labels from sysfile H and inserts them into the
1018    associated dictionary. */
1019 int
1020 read_value_labels (struct file_handle * h, struct variable ** var_by_index)
1021 {
1022   struct sfm_fhuser_ext *ext = h->ext;  /* File extension record. */
1023
1024   flt64 *raw_label = NULL;      /* Array of raw label values. */
1025   struct value_label **cooked_label = NULL;     /* Array of cooked labels. */
1026   int32 n_labels;               /* Number of labels. */
1027
1028   struct variable **var = NULL; /* Associated variables. */
1029   int32 n_vars;                 /* Number of associated variables. */
1030
1031   int i;
1032
1033   /* First step: read the contents of the type 3 record and record its
1034      contents.  Note that we can't do much with the data since we
1035      don't know yet whether it is of numeric or string type. */
1036
1037   /* Read number of labels. */
1038   assertive_bufread (h, &n_labels, sizeof n_labels, 0);
1039   if (ext->reverse_endian)
1040     bswap_int32 (&n_labels);
1041
1042   /* Allocate memory. */
1043   raw_label = xmalloc (sizeof *raw_label * n_labels);
1044   cooked_label = xmalloc (sizeof *cooked_label * n_labels);
1045   for (i = 0; i < n_labels; i++)
1046     cooked_label[i] = NULL;
1047
1048   /* Read each value/label tuple. */
1049   for (i = 0; i < n_labels; i++)
1050     {
1051       flt64 value;
1052       unsigned char label_len;
1053
1054       int rem;
1055
1056       /* Read value, label length. */
1057       assertive_bufread (h, &value, sizeof value, 0);
1058       assertive_bufread (h, &label_len, 1, 0);
1059       memcpy (&raw_label[i], &value, sizeof value);
1060
1061       /* Read label. */
1062       cooked_label[i] = xmalloc (sizeof **cooked_label);
1063       cooked_label[i]->s = xmalloc (label_len + 1);
1064       assertive_bufread (h, cooked_label[i]->s, label_len, 0);
1065       cooked_label[i]->s[label_len] = 0;
1066
1067       /* Skip padding. */
1068       rem = REM_RND_UP (label_len + 1, sizeof (flt64));
1069       if (rem)
1070         assertive_bufread (h, &value, rem, 0);
1071     }
1072
1073   /* Second step: Read the type 4 record that has the list of
1074      variables to which the value labels are to be applied. */
1075
1076   /* Read record type of type 4 record. */
1077   {
1078     int32 rec_type;
1079
1080     assertive_bufread (h, &rec_type, sizeof rec_type, 0);
1081     if (ext->reverse_endian)
1082       bswap_int32 (&rec_type);
1083
1084     if (rec_type != 4)
1085       lose ((ME, _("%s: Variable index record (type 4) does not immediately "
1086              "follow value label record (type 3) as it ought."), h->fn));
1087   }
1088
1089   /* Read number of variables associated with value label from type 4
1090      record. */
1091   assertive_bufread (h, &n_vars, sizeof n_vars, 0);
1092   if (ext->reverse_endian)
1093     bswap_int32 (&n_vars);
1094   if (n_vars < 1 || n_vars > ext->dict->nvar)
1095     lose ((ME, _("%s: Number of variables associated with a value label (%d) "
1096            "is not between 1 and the number of variables (%d)."),
1097            h->fn, n_vars, ext->dict->nvar));
1098
1099   /* Allocate storage. */
1100   var = xmalloc (sizeof *var * n_vars);
1101
1102   /* Read the list of variables. */
1103   for (i = 0; i < n_vars; i++)
1104     {
1105       int32 var_index;
1106       struct variable *v;
1107
1108       /* Read variable index, check range. */
1109       assertive_bufread (h, &var_index, sizeof var_index, 0);
1110       if (ext->reverse_endian)
1111         bswap_int32 (&var_index);
1112       if (var_index < 1 || var_index > ext->case_size)
1113         lose ((ME, _("%s: Variable index associated with value label (%d) is "
1114                "not between 1 and the number of values (%d)."),
1115                h->fn, var_index, ext->case_size));
1116
1117       /* Make sure it's a real variable. */
1118       v = var_by_index[var_index - 1];
1119       if (v == NULL)
1120         lose ((ME, _("%s: Variable index associated with value label (%d) refers "
1121                "to a continuation of a string variable, not to an actual "
1122                "variable."), h->fn, var_index));
1123       if (v->type == ALPHA && v->width > MAX_SHORT_STRING)
1124         lose ((ME, _("%s: Value labels are not allowed on long string variables "
1125                "(%s)."), h->fn, v->name));
1126
1127       /* Add it to the list of variables. */
1128       var[i] = v;
1129     }
1130
1131   /* Type check the variables. */
1132   for (i = 1; i < n_vars; i++)
1133     if (var[i]->type != var[0]->type)
1134       lose ((ME, _("%s: Variables associated with value label are not all of "
1135              "identical type.  Variable %s has %s type, but variable %s has "
1136              "%s type."), h->fn,
1137              var[0]->name, var[0]->type == ALPHA ? _("string") : _("numeric"),
1138              var[i]->name, var[i]->type == ALPHA ? _("string") : _("numeric")));
1139
1140   /* Create a value_label for each value/label tuple, now that we know
1141      the desired type. */
1142   for (i = 0; i < n_labels; i++)
1143     {
1144       if (var[0]->type == ALPHA)
1145         {
1146           const int copy_len = min (sizeof (flt64), MAX_SHORT_STRING);
1147           memcpy (cooked_label[i]->v.s, (char *) &raw_label[i], copy_len);
1148           if (MAX_SHORT_STRING > copy_len)
1149             memset (&cooked_label[i]->v.s[copy_len], ' ',
1150                     MAX_SHORT_STRING - copy_len);
1151         } else {
1152           cooked_label[i]->v.f = raw_label[i];
1153           if (ext->reverse_endian)
1154             bswap_flt64 (&cooked_label[i]->v.f);
1155         }
1156       cooked_label[i]->ref_count = n_vars;
1157     }
1158
1159   /* Assign the value_label's to each variable. */
1160   for (i = 0; i < n_vars; i++)
1161     {
1162       struct variable *v = var[i];
1163       int j;
1164
1165       /* Create AVL tree if necessary. */
1166       if (!v->val_lab)
1167         v->val_lab = avl_create (NULL, val_lab_cmp, (void *) (v->width));
1168
1169       /* Add each label to the variable. */
1170       for (j = 0; j < n_labels; j++)
1171         {
1172           struct value_label *old = avl_replace (v->val_lab, cooked_label[j]);
1173           if (old == NULL)
1174             continue;
1175
1176           if (var[0]->type == NUMERIC)
1177             msg (MW, _("%s: File contains duplicate label for value %g for "
1178                  "variable %s."), h->fn, cooked_label[j]->v.f, v->name);
1179           else
1180             msg (MW, _("%s: File contains duplicate label for value `%.*s' "
1181                  "for variable %s."), h->fn, v->width,
1182                  cooked_label[j]->v.s, v->name);
1183
1184           free_value_label (old);
1185         }
1186     }
1187
1188   free (cooked_label);
1189   free (raw_label);
1190   free (var);
1191   return 1;
1192
1193 lossage:
1194   if (cooked_label)
1195     for (i = 0; i < n_labels; i++)
1196       if (cooked_label[i])
1197         {
1198           free (cooked_label[i]->s);
1199           free (cooked_label[i]);
1200         }
1201   free (raw_label);
1202   free (var);
1203   return 0;
1204 }
1205
1206 /* Reads NBYTES bytes from the file represented by H.  If BUF is
1207    non-NULL, uses that as the buffer; otherwise allocates at least
1208    MINALLOC bytes.  Returns a pointer to the buffer on success, NULL
1209    on failure. */
1210 static void *
1211 bufread (struct file_handle * h, void *buf, size_t nbytes, size_t minalloc)
1212 {
1213   struct sfm_fhuser_ext *ext = h->ext;
1214
1215   if (buf == NULL)
1216     buf = xmalloc (max (nbytes, minalloc));
1217   if (1 != fread (buf, nbytes, 1, ext->file))
1218     {
1219       if (ferror (ext->file))
1220         msg (ME, _("%s: Reading system file: %s."), h->fn, strerror (errno));
1221       else
1222         corrupt_msg (ME, _("%s: Unexpected end of file."), h->fn);
1223       return NULL;
1224     }
1225   return buf;
1226 }
1227
1228 /* Reads a document record, type 6, from system file H, and sets up
1229    the documents and n_documents fields in the associated
1230    dictionary. */
1231 static int
1232 read_documents (struct file_handle * h)
1233 {
1234   struct sfm_fhuser_ext *ext = h->ext;
1235   struct dictionary *dict = ext->dict;
1236   int32 n_lines;
1237
1238   if (dict->documents != NULL)
1239     lose ((ME, _("%s: System file contains multiple type 6 (document) records."),
1240            h->fn));
1241
1242   assertive_bufread (h, &n_lines, sizeof n_lines, 0);
1243   dict->n_documents = n_lines;
1244   if (dict->n_documents <= 0)
1245     lose ((ME, _("%s: Number of document lines (%ld) must be greater than 0."),
1246            h->fn, (long) dict->n_documents));
1247
1248   dict->documents = bufread (h, NULL, 80 * n_lines, 0);
1249   if (dict->documents == NULL)
1250     return 0;
1251   return 1;
1252
1253 lossage:
1254   return 0;
1255 }
1256
1257 #if GLOBAL_DEBUGGING
1258 #define DEBUGGING 1
1259 #include "debug-print.h"
1260 /* Displays dictionary DICT on stdout. */
1261 void
1262 dump_dictionary (struct dictionary * dict)
1263 {
1264   int i;
1265
1266   debug_printf ((_("dictionary:\n")));
1267   for (i = 0; i < dict->nvar; i++)
1268     {
1269       char print[32];
1270       struct variable *v = dict->var[i];
1271       int n, j;
1272
1273       debug_printf (("   var %s", v->name));
1274       /*debug_printf (("(indices:%d,%d)", v->index, v->foo));*/
1275       debug_printf (("(type:%s,%d)", (v->type == NUMERIC ? _("num")
1276                                  : (v->type == ALPHA ? _("str") : "!!!")),
1277                      v->width));
1278       debug_printf (("(fv:%d,%d)", v->fv, v->nv));
1279       /*debug_printf (("(get.fv:%d,%d)", v->get.fv, v->get.nv));*/
1280       debug_printf (("(left:%s)(miss:", v->left ? _("left") : _("right")));
1281
1282       switch (v->miss_type)
1283         {
1284         case MISSING_NONE:
1285           n = 0;
1286           debug_printf ((_("none")));
1287           break;
1288         case MISSING_1:
1289           n = 1;
1290           debug_printf ((_("one")));
1291           break;
1292         case MISSING_2:
1293           n = 2;
1294           debug_printf ((_("two")));
1295           break;
1296         case MISSING_3:
1297           n = 3;
1298           debug_printf ((_("three")));
1299           break;
1300         case MISSING_RANGE:
1301           n = 2;
1302           debug_printf ((_("range")));
1303           break;
1304         case MISSING_LOW:
1305           n = 1;
1306           debug_printf ((_("low")));
1307           break;
1308         case MISSING_HIGH:
1309           n = 1;
1310           debug_printf ((_("high")));
1311           break;
1312         case MISSING_RANGE_1:
1313           n = 3;
1314           debug_printf ((_("range+1")));
1315           break;
1316         case MISSING_LOW_1:
1317           n = 2;
1318           debug_printf ((_("low+1")));
1319           break;
1320         case MISSING_HIGH_1:
1321           n = 2;
1322           debug_printf ((_("high+1")));
1323           break;
1324         default:
1325           assert (0);
1326         }
1327       for (j = 0; j < n; j++)
1328         if (v->type == NUMERIC)
1329           debug_printf ((",%g", v->missing[j].f));
1330         else
1331           debug_printf ((",\"%.*s\"", v->width, v->missing[j].s));
1332       strcpy (print, fmt_to_string (&v->print));
1333       debug_printf ((")(fmt:%s,%s)(lbl:%s)\n",
1334                      print, fmt_to_string (&v->write),
1335                      v->label ? v->label : "nolabel"));
1336     }
1337 }
1338 #endif
1339 \f
1340 /* Data reader. */
1341
1342 /* Reads compressed data into H->BUF and sets other pointers
1343    appropriately.  Returns nonzero only if both no errors occur and
1344    data was read. */
1345 static int
1346 buffer_input (struct file_handle * h)
1347 {
1348   struct sfm_fhuser_ext *ext = h->ext;
1349   size_t amt;
1350
1351   if (ext->buf == NULL)
1352     ext->buf = xmalloc (sizeof *ext->buf * 128);
1353   amt = fread (ext->buf, sizeof *ext->buf, 128, ext->file);
1354   if (ferror (ext->file))
1355     {
1356       msg (ME, _("%s: Error reading file: %s."), h->fn, strerror (errno));
1357       return 0;
1358     }
1359   ext->ptr = ext->buf;
1360   ext->end = &ext->buf[amt];
1361   return amt;
1362 }
1363
1364 /* Reads a single case consisting of compressed data from system file
1365    H into the array TEMP[] according to dictionary DICT, and returns
1366    nonzero only if successful. */
1367 /* Data in system files is compressed in the following manner:
1368    data values are grouped into sets of eight; each of the eight has
1369    one instruction byte, which are output together in an octet; each
1370    byte gives a value for that byte or indicates that the value can be
1371    found following the instructions. */
1372 static int
1373 read_compressed_data (struct file_handle * h, flt64 * temp)
1374 {
1375   struct sfm_fhuser_ext *ext = h->ext;
1376
1377   const unsigned char *p_end = ext->x + sizeof (flt64);
1378   unsigned char *p = ext->y;
1379
1380   const flt64 *temp_beg = temp;
1381   const flt64 *temp_end = &temp[ext->case_size];
1382
1383   for (;;)
1384     {
1385       for (; p < p_end; p++)
1386         switch (*p)
1387           {
1388           case 0:
1389             /* Code 0 is ignored. */
1390             continue;
1391           case 252:
1392             /* Code 252 is end of file. */
1393             if (temp_beg != temp)
1394               lose ((ME, _("%s: Compressed data is corrupted.  Data ends "
1395                      "partway through a case."), h->fn));
1396             goto lossage;
1397           case 253:
1398             /* Code 253 indicates that the value is stored explicitly
1399                following the instruction bytes. */
1400             if (ext->ptr == NULL || ext->ptr >= ext->end)
1401               if (!buffer_input (h))
1402                 {
1403                   lose ((ME, _("%s: Unexpected end of file."), h->fn));
1404                   goto lossage;
1405                 }
1406             memcpy (temp++, ext->ptr++, sizeof *temp);
1407             if (temp >= temp_end)
1408               goto winnage;
1409             break;
1410           case 254:
1411             /* Code 254 indicates a string that is all blanks. */
1412             memset (temp++, ' ', sizeof *temp);
1413             if (temp >= temp_end)
1414               goto winnage;
1415             break;
1416           case 255:
1417             /* Code 255 indicates the system-missing value. */
1418             *temp = ext->sysmis;
1419             if (ext->reverse_endian)
1420               bswap_flt64 (temp);
1421             temp++;
1422             if (temp >= temp_end)
1423               goto winnage;
1424             break;
1425           default:
1426             /* Codes 1 through 251 inclusive are taken to indicate a
1427                value of (BYTE - BIAS), where BYTE is the byte's value
1428                and BIAS is the compression bias (generally 100.0). */
1429             *temp = *p - ext->bias;
1430             if (ext->reverse_endian)
1431               bswap_flt64 (temp);
1432             temp++;
1433             if (temp >= temp_end)
1434               goto winnage;
1435             break;
1436           }
1437
1438       /* We have reached the end of this instruction octet.  Read
1439          another. */
1440       if (ext->ptr == NULL || ext->ptr >= ext->end)
1441         if (!buffer_input (h))
1442           {
1443             if (temp_beg != temp)
1444               lose ((ME, _("%s: Unexpected end of file."), h->fn));
1445             goto lossage;
1446           }
1447       memcpy (ext->x, ext->ptr++, sizeof *temp);
1448       p = ext->x;
1449     }
1450
1451   /* Not reached. */
1452   assert (0);
1453
1454 winnage:
1455   /* We have filled up an entire record.  Update state and return
1456      successfully. */
1457   ext->y = ++p;
1458   return 1;
1459
1460 lossage:
1461   /* We have been unsuccessful at filling a record, either through i/o
1462      error or through an end-of-file indication.  Update state and
1463      return unsuccessfully. */
1464   return 0;
1465 }
1466
1467 /* Reads one case from system file H into the value array PERM
1468    according to the instructions given in associated dictionary DICT,
1469    which must have the get.* elements appropriately set.  Returns
1470    nonzero only if successful.  */
1471 int
1472 sfm_read_case (struct file_handle * h, union value * perm, struct dictionary * dict)
1473 {
1474   struct sfm_fhuser_ext *ext = h->ext;
1475
1476   size_t nbytes;
1477   flt64 *temp;
1478
1479   int i;
1480
1481   /* Make sure the caller remembered to finish polishing the
1482      dictionary returned by sfm_read_dictionary(). */
1483   assert (dict->nval > 0);
1484
1485   /* The first concern is to obtain a full case relative to the data
1486      file.  (Cases in the data file have no particular relationship to
1487      cases in the active file.) */
1488   nbytes = sizeof *temp * ext->case_size;
1489   temp = local_alloc (nbytes);
1490
1491   if (ext->compressed == 0)
1492     {
1493       size_t amt = fread (temp, 1, nbytes, ext->file);
1494
1495       if (amt != nbytes)
1496         {
1497           if (ferror (ext->file))
1498             msg (ME, _("%s: Reading system file: %s."), h->fn, strerror (errno));
1499           else if (amt != 0)
1500             msg (ME, _("%s: Partial record at end of system file."), h->fn);
1501           goto lossage;
1502         }
1503     }
1504   else if (!read_compressed_data (h, temp))
1505     goto lossage;
1506
1507   /* Translate a case in data file format to a case in active file
1508      format. */
1509   for (i = 0; i < dict->nvar; i++)
1510     {
1511       struct variable *v = dict->var[i];
1512
1513       if (v->get.fv == -1)
1514         continue;
1515
1516       if (v->type == NUMERIC)
1517         {
1518           flt64 src = temp[v->get.fv];
1519           if (ext->reverse_endian)
1520             bswap_flt64 (&src);
1521           perm[v->fv].f = src == ext->sysmis ? SYSMIS : src;
1522         }
1523       else
1524         memcpy (&perm[v->fv].s, &temp[v->get.fv], v->width);
1525     }
1526
1527   local_free (temp);
1528   return 1;
1529
1530 lossage:
1531   local_free (temp);
1532   return 0;
1533 }
1534
1535 static struct fh_ext_class sfm_r_class =
1536 {
1537   3,
1538   N_("reading as a system file"),
1539   sfm_close,
1540 };