src/get.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 #include <config.h>
  21 #include <assert.h>
  22 #include <stdlib.h>
  23 #include "alloc.h"
  24 #include "command.h"
  25 #include "error.h"
  26 #include "file-handle.h"
  27 #include "hash.h"
  28 #include "lexer.h"
  29 #include "misc.h"
  30 #include "pfm.h"
  31 #include "settings.h"
  32 #include "sfm.h"
  33 #include "str.h"
  34 #include "value-labels.h"
  35 #include "var.h"
  36 #include "vfm.h"
  37 #include "vfmP.h"
  38
  39 #include "debug-print.h"
  40
  41 /* GET or IMPORT input program. */
  42 struct get_pgm
  43   {
  44     struct file_handle *handle; /* File to GET or IMPORT from. */
  45     size_t case_size;           /* Case size in bytes. */
  46   };
  47
  48 /* XSAVE transformation (and related SAVE, EXPORT procedures). */
  49 struct save_trns
  50   {
  51     struct trns_header h;
  52     struct file_handle *f;      /* Associated system file. */
  53     int nvar;                   /* Number of variables. */
  54     struct variable **var;      /* Variables. */
  55     flt64 *case_buf;            /* Case transfer buffer. */
  56   };
  57
  58 /* Options bits set by trim_dictionary(). */
  59 #define GTSV_OPT_COMPRESSED     001     /* Compression; (X)SAVE only. */
  60 #define GTSV_OPT_SAVE           002     /* The SAVE/XSAVE/EXPORT procedures. */
  61 #define GTSV_OPT_MATCH_FILES    004     /* The MATCH FILES procedure. */
  62 #define GTSV_OPT_NONE           0
  63
  64 static int trim_dictionary (struct dictionary * dict, int *options);
  65 static int save_write_case_func (struct ccase *, void *);
  66 static trns_proc_func save_trns_proc;
  67 static trns_free_func save_trns_free;
  68
  69 #if DEBUGGING
  70 void dump_dict_variables (struct dictionary *);
  71 #endif
  72
  73 /* Parses the GET command. */
  74 int
  75 cmd_get (void)
  76 {
  77   struct file_handle *handle;
  78   struct dictionary *dict;
  79   struct get_pgm *pgm;
  80   int options = GTSV_OPT_NONE;
  81
  82   lex_match_id ("GET");
  83   discard_variables ();
  84
  85   lex_match ('/');
  86   if (lex_match_id ("FILE"))
  87     lex_match ('=');
  88
  89   handle = fh_parse_file_handle ();
  90   if (handle == NULL)
  91     return CMD_FAILURE;
  92
  93   dict = sfm_read_dictionary (handle, NULL);
  94   if (dict == NULL)
  95     return CMD_FAILURE;
  96
  97 #if DEBUGGING
  98   dump_dict_variables (dict);
  99 #endif
 100   if (0 == trim_dictionary (dict, &options))
 101     {
 102       fh_close_handle (handle);
 103       return CMD_FAILURE;
 104     }
 105 #if DEBUGGING
 106   dump_dict_variables (dict);
 107 #endif
 108
 109   dict_compact_values (dict);
 110
 111 #if DEBUGGING
 112   printf (_("GET translation table from file to memory:\n"));
 113   for (i = 0; i < dict->nvar; i++)
 114     {
 115       struct variable *v = dict->var[i];
 116
 117       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
 118               v->get.fv, v->get.nv, v->fv, v->nv);
 119     }
 120 #endif
 121
 122   dict_destroy (default_dict);
 123   default_dict = dict;
 124
 125   pgm = xmalloc (sizeof *pgm);
 126   pgm->handle = handle;
 127   pgm->case_size = dict_get_case_size (default_dict);
 128   vfm_source = create_case_source (&get_source_class, default_dict, pgm);
 129
 130   return CMD_SUCCESS;
 131 }
 132
 133 /* SAVE or XSAVE command? */
 134 enum save_cmd
 135   {
 136     CMD_SAVE,
 137     CMD_XSAVE
 138   };
 139
 140 /* Parses the SAVE and XSAVE commands.  */
 141 static int
 142 cmd_save_internal (enum save_cmd save_cmd)
 143 {
 144   struct file_handle *handle;
 145   struct dictionary *dict;
 146   int options = GTSV_OPT_SAVE;
 147
 148   struct save_trns *t;
 149   struct sfm_write_info inf;
 150
 151   int i;
 152
 153   lex_match_id ("SAVE");
 154
 155   lex_match ('/');
 156   if (lex_match_id ("OUTFILE"))
 157     lex_match ('=');
 158
 159   handle = fh_parse_file_handle ();
 160   if (handle == NULL)
 161     return CMD_FAILURE;
 162
 163   dict = dict_clone (default_dict);
 164 #if DEBUGGING
 165   dump_dict_variables (dict);
 166 #endif
 167   for (i = 0; i < dict_get_var_cnt (dict); i++)
 168     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
 169   if (0 == trim_dictionary (dict, &options))
 170     {
 171       fh_close_handle (handle);
 172       return CMD_FAILURE;
 173     }
 174
 175 #if DEBUGGING
 176   dump_dict_variables (dict);
 177 #endif
 178
 179   /* Write dictionary. */
 180   inf.h = handle;
 181   inf.dict = dict;
 182   inf.compress = !!(options & GTSV_OPT_COMPRESSED);
 183   if (!sfm_write_dictionary (&inf))
 184     {
 185       dict_destroy (dict);
 186       fh_close_handle (handle);
 187       return CMD_FAILURE;
 188     }
 189
 190   /* Fill in transformation structure. */
 191   t = xmalloc (sizeof *t);
 192   t->h.proc = save_trns_proc;
 193   t->h.free = save_trns_free;
 194   t->f = handle;
 195   t->nvar = dict_get_var_cnt (dict);
 196   t->var = xmalloc (sizeof *t->var * t->nvar);
 197   for (i = 0; i < t->nvar; i++)
 198     t->var[i] = dict_get_var (dict, i)->aux;
 199   t->case_buf = xmalloc (sizeof *t->case_buf * inf.case_size);
 200   dict_destroy (dict);
 201
 202   if (save_cmd == CMD_SAVE)
 203     {
 204       procedure (save_write_case_func, t);
 205       save_trns_free (&t->h);
 206     }
 207   else
 208     {
 209       assert (save_cmd == CMD_XSAVE);
 210       add_transformation (&t->h);
 211     }
 212
 213   return CMD_SUCCESS;
 214 }
 215
 216 /* Parses and performs the SAVE procedure. */
 217 int
 218 cmd_save (void)
 219 {
 220   return cmd_save_internal (CMD_SAVE);
 221 }
 222
 223 /* Parses the XSAVE transformation command. */
 224 int
 225 cmd_xsave (void)
 226 {
 227   return cmd_save_internal (CMD_XSAVE);
 228 }
 229
 230 /* Writes the given C to the file specified by T. */
 231 static void
 232 do_write_case (struct save_trns *t, struct ccase *c)
 233 {
 234   flt64 *p = t->case_buf;
 235   int i;
 236
 237   for (i = 0; i < t->nvar; i++)
 238     {
 239       struct variable *v = t->var[i];
 240       if (v->type == NUMERIC)
 241         {
 242           double src = c->data[v->fv].f;
 243           if (src == SYSMIS)
 244             *p++ = -FLT64_MAX;
 245           else
 246             *p++ = src;
 247         }
 248       else
 249         {
 250           memcpy (p, c->data[v->fv].s, v->width);
 251           memset (&((char *) p)[v->width], ' ',
 252                   REM_RND_UP (v->width, sizeof *p));
 253           p += DIV_RND_UP (v->width, sizeof *p);
 254         }
 255     }
 256
 257   sfm_write_case (t->f, t->case_buf, p - t->case_buf);
 258 }
 259
 260 /* Writes case C to the system file specified on SAVE. */
 261 static int
 262 save_write_case_func (struct ccase *c, void *aux UNUSED)
 263 {
 264   do_write_case (aux, c);
 265   return 1;
 266 }
 267
 268 /* Writes case C to the system file specified on XSAVE. */
 269 static int
 270 save_trns_proc (struct trns_header *h, struct ccase *c, int case_num UNUSED)
 271 {
 272   struct save_trns *t = (struct save_trns *) h;
 273   do_write_case (t, c);
 274   return -1;
 275 }
 276
 277 /* Frees a SAVE transformation. */
 278 static void
 279 save_trns_free (struct trns_header *pt)
 280 {
 281   struct save_trns *t = (struct save_trns *) pt;
 282
 283   fh_close_handle (t->f);
 284   free (t->var);
 285   free (t->case_buf);
 286   free (t);
 287 }
 288
 289 static int rename_variables (struct dictionary * dict);
 290
 291 /* The GET and SAVE commands have a common structure after the
 292    FILE/OUTFILE subcommand.  This function parses this structure and
 293    returns nonzero on success, zero on failure.  It both reads
 294    *OPTIONS, for the GTSV_OPT_SAVE bit, and writes it, for the
 295    GTSV_OPT_COMPRESSED bit. */
 296 /* FIXME: IN, FIRST, LAST, MAP. */
 297 /* FIXME?  Should we call dict_compact_values() on dict as a
 298    final step? */
 299 static int
 300 trim_dictionary (struct dictionary *dict, int *options)
 301 {
 302   if (set_scompression)
 303     *options |= GTSV_OPT_COMPRESSED;
 304
 305   if (*options & GTSV_OPT_SAVE)
 306     {
 307       /* Delete all the scratch variables. */
 308       struct variable **v;
 309       size_t nv;
 310       size_t i;
 311
 312       v = xmalloc (sizeof *v * dict_get_var_cnt (dict));
 313       nv = 0;
 314       for (i = 0; i < dict_get_var_cnt (dict); i++)
 315         if (dict_class_from_id (dict_get_var (dict, i)->name) == DC_SCRATCH)
 316           v[nv++] = dict_get_var (dict, i);
 317       dict_delete_vars (dict, v, nv);
 318       free (v);
 319     }
 320
 321   while ((*options & GTSV_OPT_MATCH_FILES) || lex_match ('/'))
 322     {
 323       if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("COMPRESSED"))
 324         *options |= GTSV_OPT_COMPRESSED;
 325       else if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("UNCOMPRESSED"))
 326         *options &= ~GTSV_OPT_COMPRESSED;
 327       else if (lex_match_id ("DROP"))
 328         {
 329           struct variable **v;
 330           int nv;
 331
 332           lex_match ('=');
 333           if (!parse_variables (dict, &v, &nv, PV_NONE))
 334             return 0;
 335           dict_delete_vars (dict, v, nv);
 336           free (v);
 337         }
 338       else if (lex_match_id ("KEEP"))
 339         {
 340           struct variable **v;
 341           int nv;
 342           int i;
 343
 344           lex_match ('=');
 345           if (!parse_variables (dict, &v, &nv, PV_NONE))
 346             return 0;
 347
 348           /* Move the specified variables to the beginning. */
 349           dict_reorder_vars (dict, v, nv);
 350
 351           /* Delete the remaining variables. */
 352           v = xrealloc (v, (dict_get_var_cnt (dict) - nv) * sizeof *v);
 353           for (i = nv; i < dict_get_var_cnt (dict); i++)
 354             v[i - nv] = dict_get_var (dict, i);
 355           dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
 356           free (v);
 357         }
 358       else if (lex_match_id ("RENAME"))
 359         {
 360           if (!rename_variables (dict))
 361             return 0;
 362         }
 363       else
 364         {
 365           lex_error (_("while expecting a valid subcommand"));
 366           return 0;
 367         }
 368
 369       if (dict_get_var_cnt (dict) == 0)
 370         {
 371           msg (SE, _("All variables deleted from system file dictionary."));
 372           return 0;
 373         }
 374
 375       if (*options & GTSV_OPT_MATCH_FILES)
 376         return 1;
 377     }
 378
 379   if (token != '.')
 380     {
 381       lex_error (_("expecting end of command"));
 382       return 0;
 383     }
 384
 385   return 1;
 386 }
 387
 388 /* Parses and performs the RENAME subcommand of GET and SAVE. */
 389 static int
 390 rename_variables (struct dictionary * dict)
 391 {
 392   int i;
 393
 394   int success = 0;
 395
 396   struct variable **v;
 397   char **new_names;
 398   int nv, nn;
 399   char *err_name;
 400
 401   int group;
 402
 403   lex_match ('=');
 404   if (token != '(')
 405     {
 406       struct variable *v;
 407
 408       v = parse_dict_variable (dict);
 409       if (v == NULL)
 410         return 0;
 411       if (!lex_force_match ('=')
 412           || !lex_force_id ())
 413         return 0;
 414       if (!strncmp (tokid, v->name, 8))
 415         return 1;
 416       if (dict_lookup_var (dict, tokid) != NULL)
 417         {
 418           msg (SE, _("Cannot rename %s as %s because there already exists "
 419                      "a variable named %s.  To rename variables with "
 420                      "overlapping names, use a single RENAME subcommand "
 421                      "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
 422                      "\"/RENAME (A B C=B C A)\"."), v->name, tokid, tokid);
 423           return 0;
 424         }
 425
 426       dict_rename_var (dict, v, tokid);
 427       lex_get ();
 428       return 1;
 429     }
 430
 431   nv = nn = 0;
 432   v = NULL;
 433   new_names = 0;
 434   group = 1;
 435   while (lex_match ('('))
 436     {
 437       int old_nv = nv;
 438
 439       if (!parse_variables (dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
 440         goto done;
 441       if (!lex_match ('='))
 442         {
 443           msg (SE, _("`=' expected after variable list."));
 444           goto done;
 445         }
 446       if (!parse_DATA_LIST_vars (&new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
 447         goto done;
 448       if (nn != nv)
 449         {
 450           msg (SE, _("Number of variables on left side of `=' (%d) does not "
 451                "match number of variables on right side (%d), in "
 452                "parenthesized group %d of RENAME subcommand."),
 453                nv - old_nv, nn - old_nv, group);
 454           goto done;
 455         }
 456       if (!lex_force_match (')'))
 457         goto done;
 458       group++;
 459     }
 460
 461   if (!dict_rename_vars (dict, v, new_names, nv, &err_name))
 462     {
 463       msg (SE, _("Requested renaming duplicates variable name %s."), err_name);
 464       goto done;
 465     }
 466   success = 1;
 467
 468 done:
 469   for (i = 0; i < nn; i++)
 470     free (new_names[i]);
 471   free (new_names);
 472   free (v);
 473
 474   return success;
 475 }
 476
 477 #if DEBUGGING
 478 void
 479 dump_dict_variables (struct dictionary * dict)
 480 {
 481   int i;
 482
 483   printf (_("\nVariables in dictionary:\n"));
 484   for (i = 0; i < dict->nvar; i++)
 485     printf ("%s, ", dict->var[i]->name);
 486   printf ("\n");
 487 }
 488 #endif
 489 \f
 490 /* Clears internal state related to GET input procedure. */
 491 static void
 492 get_source_destroy (struct case_source *source)
 493 {
 494   struct get_pgm *pgm = source->aux;
 495
 496   /* It is not necessary to destroy the dictionary because if we get
 497      to this point then the dictionary is default_dict. */
 498   fh_close_handle (pgm->handle);
 499   free (pgm);
 500 }
 501
 502 /* Reads all the cases from the data file into C and passes them
 503    to WRITE_CASE one by one, passing WC_DATA. */
 504 static void
 505 get_source_read (struct case_source *source,
 506                  struct ccase *c,
 507                  write_case_func *write_case, write_case_data wc_data)
 508 {
 509   struct get_pgm *pgm = source->aux;
 510
 511   while (sfm_read_case (pgm->handle, c->data, default_dict)
 512          && write_case (wc_data))
 513     ;
 514 }
 515
 516 const struct case_source_class get_source_class =
 517   {
 518     "GET",
 519     NULL,
 520     get_source_read,
 521     get_source_destroy,
 522   };
 523
 524 \f
 525 /* MATCH FILES. */
 526
 527 #include "debug-print.h"
 528
 529 /* File types. */
 530 enum
 531   {
 532     MTF_FILE,                   /* Specified on FILE= subcommand. */
 533     MTF_TABLE                   /* Specified on TABLE= subcommand. */
 534   };
 535
 536 /* One of the files on MATCH FILES. */
 537 struct mtf_file
 538   {
 539     struct mtf_file *next, *prev;
 540                                 /* Next, previous in the list of files. */
 541     struct mtf_file *next_min;  /* Next in the chain of minimums. */
 542
 543     int type;                   /* One of MTF_*. */
 544     struct variable **by;       /* List of BY variables for this file. */
 545     struct file_handle *handle; /* File handle for the file. */
 546     struct dictionary *dict;    /* Dictionary from system file. */
 547     char in[9];                 /* Name of the variable from IN=. */
 548     char first[9], last[9];     /* Name of the variables from FIRST=, LAST=. */
 549     union value *input;         /* Input record. */
 550   };
 551
 552 /* MATCH FILES procedure. */
 553 struct mtf_proc
 554   {
 555     struct mtf_file *head;      /* First file mentioned on FILE or TABLE. */
 556     struct mtf_file *tail;      /* Last file mentioned on FILE or TABLE. */
 557
 558     struct variable **by;       /* Variables on the BY subcommand. */
 559     size_t by_cnt;              /* Number of variables on BY subcommand. */
 560
 561     struct dictionary *dict;    /* Dictionary of output file. */
 562     struct case_sink *sink;     /* Sink to receive output. */
 563     struct ccase *mtf_case;     /* Case used for output. */
 564
 565     unsigned seq_num;           /* Have we initialized this variable? */
 566     unsigned *seq_nums;         /* Sequence numbers for each var in dict. */
 567   };
 568
 569 static void mtf_free (struct mtf_proc *);
 570 static void mtf_free_file (struct mtf_file *);
 571 static int mtf_merge_dictionary (struct dictionary *const, struct mtf_file *);
 572 static void mtf_delete_file_in_place (struct mtf_proc *, struct mtf_file **);
 573
 574 static void mtf_read_nonactive_records (void *);
 575 static void mtf_processing_finish (void *);
 576 static int mtf_processing (struct ccase *, void *);
 577
 578 static char *var_type_description (struct variable *);
 579
 580 /* Parse and execute the MATCH FILES command. */
 581 int
 582 cmd_match_files (void)
 583 {
 584   struct mtf_proc mtf;
 585   struct mtf_file *first_table = NULL;
 586
 587   int seen = 0;
 588
 589   lex_match_id ("MATCH");
 590   lex_match_id ("FILES");
 591
 592   mtf.head = mtf.tail = NULL;
 593   mtf.by = NULL;
 594   mtf.by_cnt = 0;
 595   mtf.dict = dict_create ();
 596   mtf.sink = NULL;
 597   mtf.mtf_case = NULL;
 598   mtf.seq_num = 0;
 599   mtf.seq_nums = NULL;
 600   dict_set_case_limit (mtf.dict, dict_get_case_limit (default_dict));
 601
 602   do
 603     {
 604       lex_match ('/');
 605
 606       if (lex_match (T_BY))
 607         {
 608           if (seen & 1)
 609             {
 610               msg (SE, _("The BY subcommand may be given once at most."));
 611               goto lossage;
 612             }
 613           seen |= 1;
 614
 615           lex_match ('=');
 616           if (!parse_variables (mtf.dict, &mtf.by, &mtf.by_cnt,
 617                                 PV_NO_DUPLICATE | PV_NO_SCRATCH))
 618             goto lossage;
 619         }
 620       else if (token != T_ID)
 621         {
 622           lex_error (NULL);
 623           goto lossage;
 624         }
 625       else if (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid))
 626         {
 627           struct mtf_file *file = xmalloc (sizeof *file);
 628
 629           file->in[0] = file->first[0] = file->last[0] = '\0';
 630           file->dict = NULL;
 631           file->by = NULL;
 632           file->input = NULL;
 633
 634           if (lex_match_id ("FILE"))
 635             file->type = MTF_FILE;
 636           else if (lex_match_id ("TABLE"))
 637             {
 638               file->type = MTF_TABLE;
 639               seen |= 4;
 640             }
 641           else
 642             assert (0);
 643
 644           /* FILEs go first, then TABLEs. */
 645           if (file->type == MTF_TABLE || first_table == NULL)
 646             {
 647               file->next = NULL;
 648               file->prev = mtf.tail;
 649               if (mtf.tail)
 650                 mtf.tail->next = file;
 651               mtf.tail = file;
 652               if (mtf.head == NULL)
 653                 mtf.head = file;
 654               if (file->type == MTF_TABLE && first_table == NULL)
 655                 first_table = file;
 656             }
 657           else
 658             {
 659               assert (file->type == MTF_FILE);
 660               file->next = first_table;
 661               file->prev = first_table->prev;
 662               if (first_table->prev)
 663                 first_table->prev->next = file;
 664               else
 665                 mtf.head = file;
 666               first_table->prev = file;
 667             }
 668
 669           lex_match ('=');
 670
 671           if (lex_match ('*'))
 672             {
 673               file->handle = NULL;
 674
 675               if (seen & 2)
 676                 {
 677                   msg (SE, _("The active file may not be specified more "
 678                              "than once."));
 679                   goto lossage;
 680                 }
 681               seen |= 2;
 682
 683               assert (pgm_state != STATE_INPUT);
 684               if (pgm_state == STATE_INIT)
 685                 {
 686                   msg (SE, _("Cannot specify the active file since no active "
 687                              "file has been defined."));
 688                   goto lossage;
 689                 }
 690
 691               if (temporary != 0)
 692                 {
 693                   msg (SE,
 694                        _("MATCH FILES may not be used after TEMPORARY when "
 695                          "the active file is an input source.  "
 696                          "Temporary transformations will be made permanent."));
 697                   cancel_temporary ();
 698                 }
 699             }
 700           else
 701             {
 702               file->handle = fh_parse_file_handle ();
 703               if (!file->handle)
 704                 goto lossage;
 705             }
 706
 707           if (file->handle)
 708             {
 709               file->dict = sfm_read_dictionary (file->handle, NULL);
 710               if (!file->dict)
 711                 goto lossage;
 712             }
 713           else
 714             file->dict = default_dict;
 715           if (!mtf_merge_dictionary (mtf.dict, file))
 716             goto lossage;
 717         }
 718       else if (lex_id_match ("IN", tokid)
 719                || lex_id_match ("FIRST", tokid)
 720                || lex_id_match ("LAST", tokid))
 721         {
 722           const char *sbc;
 723           char *name;
 724
 725           if (mtf.tail == NULL)
 726             {
 727               msg (SE, _("IN, FIRST, and LAST subcommands may not occur "
 728                          "before the first FILE or TABLE."));
 729               goto lossage;
 730             }
 731
 732           if (lex_match_id ("IN"))
 733             {
 734               name = mtf.tail->in;
 735               sbc = "IN";
 736             }
 737           else if (lex_match_id ("FIRST"))
 738             {
 739               name = mtf.tail->first;
 740               sbc = "FIRST";
 741             }
 742           else if (lex_match_id ("LAST"))
 743             {
 744               name = mtf.tail->last;
 745               sbc = "LAST";
 746             }
 747           else
 748             assert (0);
 749
 750           lex_match ('=');
 751           if (token != T_ID)
 752             {
 753               lex_error (NULL);
 754               goto lossage;
 755             }
 756
 757           if (*name)
 758             {
 759               msg (SE, _("Multiple %s subcommands for a single FILE or "
 760                          "TABLE."),
 761                    sbc);
 762               goto lossage;
 763             }
 764           strcpy (name, tokid);
 765           lex_get ();
 766
 767           if (!dict_create_var (mtf.dict, name, 0))
 768             {
 769               msg (SE, _("Duplicate variable name %s while creating %s "
 770                          "variable."),
 771                    name, sbc);
 772               goto lossage;
 773             }
 774         }
 775       else if (lex_id_match ("RENAME", tokid)
 776                || lex_id_match ("KEEP", tokid)
 777                || lex_id_match ("DROP", tokid))
 778         {
 779           int options = GTSV_OPT_MATCH_FILES;
 780
 781           if (mtf.tail == NULL)
 782             {
 783               msg (SE, _("RENAME, KEEP, and DROP subcommands may not occur "
 784                          "before the first FILE or TABLE."));
 785               goto lossage;
 786             }
 787
 788           if (!trim_dictionary (mtf.tail->dict, &options))
 789             goto lossage;
 790         }
 791       else if (lex_match_id ("MAP"))
 792         {
 793           /* FIXME. */
 794         }
 795       else
 796         {
 797           lex_error (NULL);
 798           goto lossage;
 799         }
 800     }
 801   while (token != '.');
 802
 803   if (seen & 4)
 804     {
 805       if (!(seen & 1))
 806         {
 807           msg (SE, _("The BY subcommand is required when a TABLE subcommand "
 808                      "is given."));
 809           goto lossage;
 810         }
 811     }
 812
 813   if (seen & 1)
 814     {
 815       struct mtf_file *iter;
 816
 817       for (iter = mtf.head; iter; iter = iter->next)
 818         {
 819           int i;
 820
 821           iter->by = xmalloc (sizeof *iter->by * mtf.by_cnt);
 822
 823           for (i = 0; i < mtf.by_cnt; i++)
 824             {
 825               iter->by[i] = dict_lookup_var (iter->dict, mtf.by[i]->name);
 826               if (iter->by[i] == NULL)
 827                 {
 828                   msg (SE, _("File %s lacks BY variable %s."),
 829                        iter->handle ? fh_handle_name (iter->handle) : "*",
 830                        mtf.by[i]->name);
 831                   goto lossage;
 832                 }
 833             }
 834         }
 835     }
 836
 837 #if DEBUGGING
 838   {
 839     /* From sfm-read.c. */
 840     extern void dump_dictionary (struct dictionary *);
 841
 842     dump_dictionary (mtf.dict);
 843   }
 844 #endif
 845
 846   /* MATCH FILES performs an n-way merge on all its input files.
 847      Abstract algorithm:
 848
 849      1. Read one input record from every input FILE.
 850
 851      2. If no FILEs are left, stop.  Otherwise, proceed to step 3.
 852
 853      3. Find the FILE input record with minimum BY values.  Store all
 854      the values from this input record into the output record.
 855
 856      4. Find all the FILE input records with BY values identical to
 857      the minimums.  Store all the values from these input records into
 858      the output record.
 859
 860      5. For every TABLE, read another record as long as the BY values
 861      on the TABLE's input record are less than the FILEs' BY values.
 862      If an exact match is found, store all the values from the TABLE
 863      input record into the output record.
 864
 865      6. Write the output record.
 866
 867      7. Read another record from each input file FILE and TABLE that
 868      we stored values from above.  If we come to the end of one of the
 869      input files, remove it from the list of input files.
 870
 871      8. Repeat from step 2.
 872
 873      Unfortunately, this algorithm can't be directly implemented
 874      because there's no function to read a record from the active
 875      file; instead, it has to be done using callbacks.
 876
 877      FIXME: For merging large numbers of files (more than 10?) a
 878      better algorithm would use a heap for finding minimum
 879      values. */
 880
 881   if (!(seen & 2))
 882     discard_variables ();
 883
 884   mtf.sink = create_case_sink (&storage_sink_class, mtf.dict, NULL);
 885
 886   mtf.seq_nums = xmalloc (dict_get_var_cnt (mtf.dict)
 887                           * sizeof *mtf.seq_nums);
 888   memset (mtf.seq_nums, 0,
 889           dict_get_var_cnt (mtf.dict) * sizeof *mtf.seq_nums);
 890   mtf.mtf_case = xmalloc (dict_get_case_size (mtf.dict));
 891
 892   mtf_read_nonactive_records (NULL);
 893   if (seen & 2)
 894     procedure (mtf_processing, NULL);
 895   mtf_processing_finish (NULL);
 896
 897   dict_destroy (default_dict);
 898   default_dict = mtf.dict;
 899   mtf.dict = NULL;
 900   vfm_source = mtf.sink->class->make_source (mtf.sink);
 901   free_case_sink (mtf.sink);
 902
 903   mtf_free (&mtf);
 904   return CMD_SUCCESS;
 905
 906 lossage:
 907   mtf_free (&mtf);
 908   return CMD_FAILURE;
 909 }
 910
 911 /* Repeats 2...8 an arbitrary number of times. */
 912 static void
 913 mtf_processing_finish (void *mtf_)
 914 {
 915   struct mtf_proc *mtf = mtf_;
 916   struct mtf_file *iter;
 917
 918   /* Find the active file and delete it. */
 919   for (iter = mtf->head; iter; iter = iter->next)
 920     if (iter->handle == NULL)
 921       {
 922         mtf_delete_file_in_place (mtf, &iter);
 923         break;
 924       }
 925
 926   while (mtf->head && mtf->head->type == MTF_FILE)
 927     if (!mtf_processing (NULL, mtf))
 928       break;
 929 }
 930
 931 /* Return a string in a static buffer describing V's variable type and
 932    width. */
 933 static char *
 934 var_type_description (struct variable *v)
 935 {
 936   static char buf[2][32];
 937   static int x = 0;
 938   char *s;
 939
 940   x ^= 1;
 941   s = buf[x];
 942
 943   if (v->type == NUMERIC)
 944     strcpy (s, "numeric");
 945   else
 946     {
 947       assert (v->type == ALPHA);
 948       sprintf (s, "string with width %d", v->width);
 949     }
 950   return s;
 951 }
 952
 953 /* Free FILE and associated data. */
 954 static void
 955 mtf_free_file (struct mtf_file *file)
 956 {
 957   fh_close_handle (file->handle);
 958   if (file->dict != NULL && file->dict != default_dict)
 959     dict_destroy (file->dict);
 960   free (file->by);
 961   if (file->handle)
 962     free (file->input);
 963   free (file);
 964 }
 965
 966 /* Free all the data for the MATCH FILES procedure. */
 967 static void
 968 mtf_free (struct mtf_proc *mtf)
 969 {
 970   struct mtf_file *iter, *next;
 971
 972   for (iter = mtf->head; iter; iter = next)
 973     {
 974       next = iter->next;
 975
 976       mtf_free_file (iter);
 977     }
 978
 979   free (mtf->by);
 980   if (mtf->dict)
 981     dict_destroy (mtf->dict);
 982   free (mtf->seq_nums);
 983 }
 984
 985 /* Remove *FILE from the mtf_file chain.  Make *FILE point to the next
 986    file in the chain, or to NULL if was the last in the chain. */
 987 static void
 988 mtf_delete_file_in_place (struct mtf_proc *mtf, struct mtf_file **file)
 989 {
 990   struct mtf_file *f = *file;
 991
 992   if (f->prev)
 993     f->prev->next = f->next;
 994   if (f->next)
 995     f->next->prev = f->prev;
 996   if (f == mtf->head)
 997     mtf->head = f->next;
 998   if (f == mtf->tail)
 999     mtf->tail = f->prev;
1000   *file = f->next;
1001
1002   {
1003     int i;
1004
1005     for (i = 0; i < dict_get_var_cnt (f->dict); i++)
1006       {
1007         struct variable *v = dict_get_var (f->dict, i);
1008
1009         if (v->type == NUMERIC)
1010           mtf->mtf_case->data[v->p.mtf.master->fv].f = SYSMIS;
1011         else
1012           memset (mtf->mtf_case->data[v->p.mtf.master->fv].s, ' ', v->width);
1013       }
1014   }
1015
1016   mtf_free_file (f);
1017 }
1018
1019 /* Read a record from every input file except the active file. */
1020 static void
1021 mtf_read_nonactive_records (void *mtf_ UNUSED)
1022 {
1023   struct mtf_proc *mtf = mtf_;
1024   struct mtf_file *iter;
1025
1026   for (iter = mtf->head; iter; )
1027     {
1028       if (iter->handle)
1029         {
1030           assert (iter->input == NULL);
1031           iter->input = xmalloc (dict_get_case_size (iter->dict));
1032
1033           if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1034             mtf_delete_file_in_place (mtf, &iter);
1035           else
1036             iter = iter->next;
1037         }
1038       else
1039         iter = iter->next;
1040     }
1041 }
1042
1043 /* Compare the BY variables for files A and B; return -1 if A < B, 0
1044    if A == B, 1 if A > B. */
1045 static inline int
1046 mtf_compare_BY_values (struct mtf_proc *mtf,
1047                        struct mtf_file *a, struct mtf_file *b,
1048                        struct ccase *c)
1049 {
1050   union value *a_input, *b_input;
1051   int i;
1052
1053   assert ((a == NULL) + (b == NULL) + (c == NULL) <= 1);
1054   a_input = a->input != NULL ? a->input : c->data;
1055   b_input = b->input != NULL ? b->input : c->data;
1056   for (i = 0; i < mtf->by_cnt; i++)
1057     {
1058       assert (a->by[i]->type == b->by[i]->type);
1059       assert (a->by[i]->width == b->by[i]->width);
1060
1061       if (a->by[i]->type == NUMERIC)
1062         {
1063           double af = a_input[a->by[i]->fv].f;
1064           double bf = b_input[b->by[i]->fv].f;
1065
1066           if (af < bf)
1067             return -1;
1068           else if (af > bf)
1069             return 1;
1070         }
1071       else
1072         {
1073           int result;
1074
1075           assert (a->by[i]->type == ALPHA);
1076           result = memcmp (a_input[a->by[i]->fv].s,
1077                            b_input[b->by[i]->fv].s,
1078                            a->by[i]->width);
1079           if (result < 0)
1080             return -1;
1081           else if (result > 0)
1082             return 1;
1083         }
1084     }
1085   return 0;
1086 }
1087
1088 /* Perform one iteration of steps 3...7 above. */
1089 static int
1090 mtf_processing (struct ccase *c, void *mtf_ UNUSED)
1091 {
1092   struct mtf_proc *mtf = mtf_;
1093   struct mtf_file *min_head, *min_tail; /* Files with minimum BY values. */
1094   struct mtf_file *max_head, *max_tail; /* Files with non-minimum BY values. */
1095   struct mtf_file *iter;                /* Iterator. */
1096
1097   for (;;)
1098     {
1099       /* If the active file doesn't have the minimum BY values, don't
1100          return because that would cause a record to be skipped. */
1101       int advance = 1;
1102
1103       if (mtf->head->type == MTF_TABLE)
1104         return 0;
1105
1106       /* 3. Find the FILE input record with minimum BY values.  Store
1107          all the values from this input record into the output record.
1108
1109          4. Find all the FILE input records with BY values identical
1110          to the minimums.  Store all the values from these input
1111          records into the output record. */
1112       min_head = min_tail = mtf->head;
1113       max_head = max_tail = NULL;
1114       for (iter = mtf->head->next; iter && iter->type == MTF_FILE;
1115            iter = iter->next)
1116         switch (mtf_compare_BY_values (mtf, min_head, iter, c))
1117           {
1118           case -1:
1119             if (max_head)
1120               max_tail = max_tail->next_min = iter;
1121             else
1122               max_head = max_tail = iter;
1123             break;
1124
1125           case 0:
1126             min_tail = min_tail->next_min = iter;
1127             break;
1128
1129           case 1:
1130             if (max_head)
1131               {
1132                 max_tail->next_min = min_head;
1133                 max_tail = min_tail;
1134               }
1135             else
1136               {
1137                 max_head = min_head;
1138                 max_tail = min_tail;
1139               }
1140             min_head = min_tail = iter;
1141             break;
1142
1143           default:
1144             assert (0);
1145           }
1146
1147       /* 5. For every TABLE, read another record as long as the BY
1148          values on the TABLE's input record are less than the FILEs'
1149          BY values.  If an exact match is found, store all the values
1150          from the TABLE input record into the output record. */
1151       while (iter)
1152         {
1153           struct mtf_file *next = iter->next;
1154
1155           assert (iter->type == MTF_TABLE);
1156
1157           if (iter->handle == NULL)
1158             advance = 0;
1159
1160         again:
1161           switch (mtf_compare_BY_values (mtf, min_head, iter, c))
1162             {
1163             case -1:
1164               if (max_head)
1165                 max_tail = max_tail->next_min = iter;
1166               else
1167                 max_head = max_tail = iter;
1168               break;
1169
1170             case 0:
1171               min_tail = min_tail->next_min = iter;
1172               break;
1173
1174             case 1:
1175               if (iter->handle == NULL)
1176                 return 1;
1177               if (sfm_read_case (iter->handle, iter->input, iter->dict))
1178                 goto again;
1179               mtf_delete_file_in_place (mtf, &iter);
1180               break;
1181
1182             default:
1183               assert (0);
1184             }
1185
1186           iter = next;
1187         }
1188
1189       /* Next sequence number. */
1190       mtf->seq_num++;
1191
1192       /* Store data to all the records we are using. */
1193       if (min_tail)
1194         min_tail->next_min = NULL;
1195       for (iter = min_head; iter; iter = iter->next_min)
1196         {
1197           int i;
1198
1199           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1200             {
1201               struct variable *v = dict_get_var (iter->dict, i);
1202               union value *record;
1203
1204               if (mtf->seq_nums[v->p.mtf.master->index] == mtf->seq_num)
1205                 continue;
1206               mtf->seq_nums[v->p.mtf.master->index] = mtf->seq_num;
1207
1208               record = iter->input != NULL ? iter->input : c->data;
1209
1210               assert (v->type == NUMERIC || v->type == ALPHA);
1211               if (v->type == NUMERIC)
1212                 mtf->mtf_case->data[v->p.mtf.master->fv].f = record[v->fv].f;
1213               else
1214                 memcpy (mtf->mtf_case->data[v->p.mtf.master->fv].s,
1215                         record[v->fv].s, v->width);
1216             }
1217         }
1218
1219       /* Store missing values to all the records we're not using. */
1220       if (max_tail)
1221         max_tail->next_min = NULL;
1222       for (iter = max_head; iter; iter = iter->next_min)
1223         {
1224           int i;
1225
1226           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1227             {
1228               struct variable *v = dict_get_var (iter->dict, i);
1229
1230               if (mtf->seq_nums[v->p.mtf.master->index] == mtf->seq_num)
1231                 continue;
1232               mtf->seq_nums[v->p.mtf.master->index] = mtf->seq_num;
1233
1234 #if 0
1235               printf ("%s/%s: dest-fv=%d\n",
1236                       fh_handle_name (iter->handle),
1237                       v->name,
1238                       v->p.mtf.master->fv);
1239 #endif
1240               if (v->type == NUMERIC)
1241                 mtf->mtf_case->data[v->p.mtf.master->fv].f = SYSMIS;
1242               else
1243                 memset (mtf->mtf_case->data[v->p.mtf.master->fv].s, ' ',
1244                         v->width);
1245             }
1246
1247           if (iter->handle == NULL)
1248             advance = 0;
1249         }
1250
1251       /* 6. Write the output record. */
1252       mtf->sink->class->write (mtf->sink, mtf->mtf_case);
1253
1254       /* 7. Read another record from each input file FILE and TABLE
1255          that we stored values from above.  If we come to the end of
1256          one of the input files, remove it from the list of input
1257          files. */
1258       for (iter = min_head; iter && iter->type == MTF_FILE; )
1259         {
1260           struct mtf_file *next = iter->next_min;
1261
1262           if (iter->handle)
1263             {
1264               assert (iter->input != NULL);
1265
1266               if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1267                 mtf_delete_file_in_place (mtf, &iter);
1268             }
1269
1270           iter = next;
1271         }
1272
1273       if (advance)
1274         break;
1275     }
1276
1277   return (mtf->head && mtf->head->type != MTF_TABLE);
1278 }
1279
1280 /* Merge the dictionary for file F into the master dictionary
1281    mtf_dict. */
1282 static int
1283 mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
1284 {
1285   struct dictionary *d = f->dict;
1286   const char *d_docs, *m_docs;
1287
1288   if (dict_get_label (m) == NULL)
1289     dict_set_label (m, dict_get_label (d));
1290
1291   d_docs = dict_get_documents (d);
1292   m_docs = dict_get_documents (m);
1293   if (d_docs != NULL)
1294     {
1295       if (m_docs == NULL)
1296         dict_set_documents (m, d_docs);
1297       else
1298         {
1299           char *new_docs;
1300           size_t new_len;
1301
1302           new_len = strlen (m_docs) + strlen (d_docs);
1303           new_docs = xmalloc (new_len + 1);
1304           strcpy (new_docs, m_docs);
1305           strcat (new_docs, d_docs);
1306           dict_set_documents (m, new_docs);
1307           free (new_docs);
1308         }
1309     }
1310
1311   dict_compact_values (d);
1312
1313   {
1314     int i;
1315
1316     for (i = 0; i < dict_get_var_cnt (d); i++)
1317       {
1318         struct variable *dv = dict_get_var (d, i);
1319         struct variable *mv = dict_lookup_var (m, dv->name);
1320
1321         assert (dv->type == ALPHA || dv->width == 0);
1322         assert (!mv || mv->type == ALPHA || mv->width == 0);
1323         if (mv && dv->width == mv->width)
1324           {
1325             if (val_labs_count (dv->val_labs)
1326                 && !val_labs_count (mv->val_labs))
1327               mv->val_labs = val_labs_copy (dv->val_labs);
1328             if (dv->miss_type != MISSING_NONE
1329                 && mv->miss_type == MISSING_NONE)
1330               copy_missing_values (mv, dv);
1331           }
1332         if (mv && dv->label && !mv->label)
1333           mv->label = xstrdup (dv->label);
1334         if (!mv)
1335           {
1336             mv = dict_clone_var (m, dv, dv->name);
1337             assert (mv != NULL);
1338           }
1339         else if (mv->width != dv->width)
1340           {
1341             msg (SE, _("Variable %s in file %s (%s) has different "
1342                        "type or width from the same variable in "
1343                        "earlier file (%s)."),
1344                  dv->name, fh_handle_name (f->handle),
1345                  var_type_description (dv), var_type_description (mv));
1346             return 0;
1347           }
1348         dv->p.mtf.master = mv;
1349       }
1350   }
1351
1352   return 1;
1353 }
1354 \f
1355 /* IMPORT command. */
1356
1357 /* Parses the IMPORT command. */
1358 int
1359 cmd_import (void)
1360 {
1361   struct file_handle *handle = NULL;
1362   struct dictionary *dict;
1363   struct get_pgm *pgm;
1364   int options = GTSV_OPT_NONE;
1365   int type;
1366
1367   lex_match_id ("IMPORT");
1368
1369   for (;;)
1370     {
1371       lex_match ('/');
1372
1373       if (lex_match_id ("FILE") || token == T_STRING)
1374         {
1375           lex_match ('=');
1376
1377           handle = fh_parse_file_handle ();
1378           if (handle == NULL)
1379             return CMD_FAILURE;
1380         }
1381       else if (lex_match_id ("TYPE"))
1382         {
1383           lex_match ('=');
1384
1385           if (lex_match_id ("COMM"))
1386             type = PFM_COMM;
1387           else if (lex_match_id ("TAPE"))
1388             type = PFM_TAPE;
1389           else
1390             {
1391               lex_error (_("expecting COMM or TAPE"));
1392               return CMD_FAILURE;
1393             }
1394         }
1395       else break;
1396     }
1397   if (!lex_match ('/') && token != '.')
1398     {
1399       lex_error (NULL);
1400       return CMD_FAILURE;
1401     }
1402
1403   discard_variables ();
1404
1405   dict = pfm_read_dictionary (handle, NULL);
1406   if (dict == NULL)
1407     return CMD_FAILURE;
1408
1409 #if DEBUGGING
1410   dump_dict_variables (dict);
1411 #endif
1412   if (0 == trim_dictionary (dict, &options))
1413     {
1414       fh_close_handle (handle);
1415       return CMD_FAILURE;
1416     }
1417 #if DEBUGGING
1418   dump_dict_variables (dict);
1419 #endif
1420
1421   dict_compact_values (dict);
1422
1423 #if DEBUGGING
1424   printf (_("IMPORT translation table from file to memory:\n"));
1425   for (i = 0; i < dict->nvar; i++)
1426     {
1427       struct variable *v = dict->var[i];
1428
1429       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
1430               v->get.fv, v->get.nv, v->fv, v->nv);
1431     }
1432 #endif
1433
1434   dict_destroy (default_dict);
1435   default_dict = dict;
1436
1437   pgm = xmalloc (sizeof *pgm);
1438   pgm->handle = handle;
1439   pgm->case_size = dict_get_case_size (default_dict);
1440   vfm_source = create_case_source (&import_source_class, default_dict, pgm);
1441
1442   return CMD_SUCCESS;
1443 }
1444
1445 /* Reads all the cases from the data file and passes them to
1446    write_case(). */
1447 static void
1448 import_source_read (struct case_source *source,
1449                     struct ccase *c,
1450                     write_case_func *write_case, write_case_data wc_data)
1451 {
1452   struct get_pgm *pgm = source->aux;
1453
1454   while (pfm_read_case (pgm->handle, c->data, default_dict))
1455     if (!write_case (wc_data))
1456       break;
1457 }
1458
1459 const struct case_source_class import_source_class =
1460   {
1461     "IMPORT",
1462     NULL,
1463     import_source_read,
1464     get_source_destroy,
1465   };
1466 \f
1467 static int export_write_case_func (struct ccase *c, void *);
1468
1469 /* Parses the EXPORT command.  */
1470 /* FIXME: same as cmd_save_internal(). */
1471 int
1472 cmd_export (void)
1473 {
1474   struct file_handle *handle;
1475   struct dictionary *dict;
1476   int options = GTSV_OPT_SAVE;
1477
1478   struct save_trns *t;
1479
1480   int i;
1481
1482   lex_match_id ("EXPORT");
1483
1484   lex_match ('/');
1485   if (lex_match_id ("OUTFILE"))
1486     lex_match ('=');
1487
1488   handle = fh_parse_file_handle ();
1489   if (handle == NULL)
1490     return CMD_FAILURE;
1491
1492   dict = dict_clone (default_dict);
1493 #if DEBUGGING
1494   dump_dict_variables (dict);
1495 #endif
1496   for (i = 0; i < dict_get_var_cnt (dict); i++)
1497     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
1498   if (0 == trim_dictionary (dict, &options))
1499     {
1500       fh_close_handle (handle);
1501       return CMD_FAILURE;
1502     }
1503
1504 #if DEBUGGING
1505   dump_dict_variables (dict);
1506 #endif
1507
1508   /* Write dictionary. */
1509   if (!pfm_write_dictionary (handle, dict))
1510     {
1511       dict_destroy (dict);
1512       fh_close_handle (handle);
1513       return CMD_FAILURE;
1514     }
1515
1516   /* Fill in transformation structure. */
1517   t = xmalloc (sizeof *t);
1518   t->h.proc = save_trns_proc;
1519   t->h.free = save_trns_free;
1520   t->f = handle;
1521   t->nvar = dict_get_var_cnt (dict);
1522   t->var = xmalloc (sizeof *t->var * t->nvar);
1523   for (i = 0; i < t->nvar; i++)
1524     t->var[i] = dict_get_var (dict, i)->aux;
1525   t->case_buf = xmalloc (sizeof *t->case_buf * t->nvar);
1526   dict_destroy (dict);
1527
1528   procedure (export_write_case_func, t);
1529   save_trns_free (&t->h);
1530
1531   return CMD_SUCCESS;
1532 }
1533
1534 /* Writes case C to the EXPORT file. */
1535 static int
1536 export_write_case_func (struct ccase *c, void *aux)
1537 {
1538   struct save_trns *t = aux;
1539   union value *p = (union value *) t->case_buf;
1540   int i;
1541
1542   for (i = 0; i < t->nvar; i++)
1543     {
1544       struct variable *v = t->var[i];
1545
1546       if (v->type == NUMERIC)
1547         *p++ = c->data[v->fv];
1548       else
1549         (*p++).c = c->data[v->fv].s;
1550     }
1551
1552   pfm_write_case (t->f, (union value *) t->case_buf);
1553   return 1;
1554 }