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