pintos-os.org Git - pspp/blob - src/data-list.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 "data-list.h"
  22 #include <assert.h>
  23 #include <ctype.h>
  24 #include <float.h>
  25 #include <stdio.h>
  26 #include <stdlib.h>
  27 #include "alloc.h"
  28 #include "command.h"
  29 #include "data-in.h"
  30 #include "debug-print.h"
  31 #include "dfm.h"
  32 #include "error.h"
  33 #include "file-handle.h"
  34 #include "format.h"
  35 #include "lexer.h"
  36 #include "misc.h"
  37 #include "settings.h"
  38 #include "str.h"
  39 #include "tab.h"
  40 #include "var.h"
  41 #include "vfm.h"
  42 \f
  43 /* Utility function. */
  44
  45 /* FIXME: Either REPEATING DATA must be the last transformation, or we
  46    must multiplex the transformations that follow (i.e., perform them
  47    for every case that we produce from a repetition instance).
  48    Currently we do neither.  We should do one or the other. */
  49
  50 /* Describes how to parse one variable. */
  51 struct dls_var_spec
  52   {
  53     struct dls_var_spec *next;
  54     struct variable *v;         /* Associated variable.  Used only in
  55                                    parsing.  Not safe later. */
  56     char name[9];               /* Free-format: Name of variable. */
  57     int rec;                    /* Fixed-format: Record number (1-based). */
  58     int fc, lc;                 /* Fixed-format: Column numbers in record. */
  59     struct fmt_spec input;      /* Input format of this field. */
  60     int fv;                     /* First value in case. */
  61     int width;                  /* 0=numeric, >0=width of alpha field. */
  62   };
  63
  64 /* Constants for DATA LIST type. */
  65 /* Must match table in cmd_data_list(). */
  66 enum
  67   {
  68     DLS_FIXED,
  69     DLS_FREE,
  70     DLS_LIST
  71   };
  72
  73 /* DATA LIST private data structure. */
  74 struct data_list_pgm
  75   {
  76     struct trns_header h;
  77     struct dls_var_spec *spec;  /* Variable parsing specifications. */
  78     struct file_handle *handle; /* Input file, never NULL. */
  79     /* Do not reorder preceding fields. */
  80
  81     int type;                   /* A DLS_* constant. */
  82     struct variable *end;       /* Variable specified on END subcommand. */
  83     int eof;                    /* End of file encountered. */
  84     int nrec;                   /* Number of records. */
  85   };
  86
  87 /* Holds information on parsing the data file. */
  88 static struct data_list_pgm dls;
  89
  90 /* Pointer to a pointer to where the first dls_var_spec should go. */
  91 static struct dls_var_spec **first;
  92
  93 /* Last dls_var_spec in the chain.  Used for building the linked-list. */
  94 static struct dls_var_spec *next;
  95
  96 static int parse_fixed (void);
  97 static int parse_free (void);
  98 static void dump_fixed_table (void);
  99 static void dump_free_table (void);
 100 static void destroy_dls (struct trns_header *);
 101 static int read_one_case (struct trns_header *, struct ccase *);
 102
 103 /* Message title for REPEATING DATA. */
 104 #define RPD_ERR "REPEATING DATA: "
 105
 106 int
 107 cmd_data_list (void)
 108 {
 109   /* 0=print no table, 1=print table.  (TABLE subcommand.)  */
 110   int table = -1;
 111
 112   lex_match_id ("DATA");
 113   lex_match_id ("LIST");
 114
 115   if (vfm_source != &input_program_source
 116       && vfm_source != &file_type_source)
 117     discard_variables ();
 118
 119   dls.handle = default_handle;
 120   dls.type = -1;
 121   dls.end = NULL;
 122   dls.eof = 0;
 123   dls.nrec = 0;
 124   dls.spec = NULL;
 125   next = NULL;
 126   first = &dls.spec;
 127
 128   while (token != '/')
 129     {
 130       if (lex_match_id ("FILE"))
 131         {
 132           lex_match ('=');
 133           dls.handle = fh_parse_file_handle ();
 134           if (!dls.handle)
 135             return CMD_FAILURE;
 136           if (vfm_source == &file_type_source && dls.handle != default_handle)
 137             {
 138               msg (SE, _("DATA LIST may not use a different file from "
 139                          "that specified on its surrounding FILE TYPE."));
 140               return CMD_FAILURE;
 141             }
 142         }
 143       else if (lex_match_id ("RECORDS"))
 144         {
 145           lex_match ('=');
 146           lex_match ('(');
 147           if (!lex_force_int ())
 148             return CMD_FAILURE;
 149           dls.nrec = lex_integer ();
 150           lex_get ();
 151           lex_match (')');
 152         }
 153       else if (lex_match_id ("END"))
 154         {
 155           if (dls.end)
 156             {
 157               msg (SE, _("The END subcommand may only be specified once."));
 158               return CMD_FAILURE;
 159             }
 160
 161           lex_match ('=');
 162           if (!lex_force_id ())
 163             return CMD_FAILURE;
 164           dls.end = dict_lookup_var (default_dict, tokid);
 165           if (!dls.end)
 166             {
 167               dls.end = dict_create_var (default_dict, tokid, 0);
 168               assert (dls.end != NULL);
 169             }
 170           lex_get ();
 171         }
 172       else if (token == T_ID)
 173         {
 174           /* Must match DLS_* constants. */
 175           static const char *id[] = {"FIXED", "FREE", "LIST", "NOTABLE",
 176                                      "TABLE", NULL};
 177           const char **p;
 178           int index;
 179
 180           for (p = id; *p; p++)
 181             if (lex_id_match (*p, tokid))
 182               break;
 183           if (*p == NULL)
 184             {
 185               lex_error (NULL);
 186               return CMD_FAILURE;
 187             }
 188
 189           lex_get ();
 190
 191           index = p - id;
 192           if (index < 3)
 193             {
 194               if (dls.type != -1)
 195                 {
 196                   msg (SE, _("Only one of FIXED, FREE, or LIST may "
 197                             "be specified."));
 198                   return CMD_FAILURE;
 199                 }
 200
 201               dls.type = index;
 202             }
 203           else
 204             table = index - 3;
 205         }
 206       else
 207         {
 208           lex_error (NULL);
 209           return CMD_FAILURE;
 210         }
 211     }
 212
 213   default_handle = dls.handle;
 214
 215   if (dls.type == -1)
 216     dls.type = DLS_FIXED;
 217
 218   if (table == -1)
 219     {
 220       if (dls.type == DLS_FREE)
 221         table = 0;
 222       else
 223         table = 1;
 224     }
 225
 226   if (dls.type == DLS_FIXED)
 227     {
 228       if (!parse_fixed ())
 229         return CMD_FAILURE;
 230       if (table)
 231         dump_fixed_table ();
 232     }
 233   else
 234     {
 235       if (!parse_free ())
 236         return CMD_FAILURE;
 237       if (table)
 238         dump_free_table ();
 239     }
 240
 241   if (vfm_source != NULL)
 242     {
 243       struct data_list_pgm *new_pgm;
 244
 245       dls.h.proc = read_one_case;
 246       dls.h.free = destroy_dls;
 247
 248       new_pgm = xmalloc (sizeof *new_pgm);
 249       memcpy (new_pgm, &dls, sizeof *new_pgm);
 250       add_transformation ((struct trns_header *) new_pgm);
 251     }
 252   else
 253     vfm_source = &data_list_source;
 254
 255   return CMD_SUCCESS;
 256 }
 257
 258 static void
 259 append_var_spec (struct dls_var_spec *spec)
 260 {
 261   if (next == 0)
 262     *first = next = xmalloc (sizeof *spec);
 263   else
 264     next = next->next = xmalloc (sizeof *spec);
 265
 266   memcpy (next, spec, sizeof *spec);
 267   next->next = NULL;
 268 }
 269 \f
 270 /* Fixed-format parsing. */
 271
 272 /* Used for chaining together fortran-like format specifiers. */
 273 struct fmt_list
 274   {
 275     struct fmt_list *next;
 276     int count;
 277     struct fmt_spec f;
 278     struct fmt_list *down;
 279   };
 280
 281 /* Used as "local" variables among the fixed-format parsing funcs.  If
 282    it were guaranteed that PSPP were going to be compiled by gcc,
 283    I'd make all these functions a single set of nested functions. */
 284 static struct
 285   {
 286     char **name;                /* Variable names. */
 287     int nname;                  /* Number of names. */
 288     int cname;                  /* dump_fmt_list: index of next name to use. */
 289
 290     int recno;                  /* Index of current record. */
 291     int sc;                     /* 1-based column number of starting column for
 292                                    next field to output. */
 293
 294     struct dls_var_spec spec;   /* Next specification to output. */
 295     int fc, lc;                 /* First, last column in set of fields specified
 296                                    together. */
 297
 298     int level;                  /* Nesting level in fixed_parse_fortran(). */
 299   }
 300 fx;
 301
 302 static int fixed_parse_compatible (void);
 303 static struct fmt_list *fixed_parse_fortran (void);
 304
 305 static int
 306 parse_fixed (void)
 307 {
 308   int i;
 309
 310   fx.recno = 0;
 311   fx.sc = 1;
 312
 313   while (token != '.')
 314     {
 315       while (lex_match ('/'))
 316         {
 317           fx.recno++;
 318           if (lex_integer_p ())
 319             {
 320               if (lex_integer () < fx.recno)
 321                 {
 322                   msg (SE, _("The record number specified, %ld, is "
 323                              "before the previous record, %d.  Data "
 324                              "fields must be listed in order of "
 325                              "increasing record number."),
 326                        lex_integer (), fx.recno - 1);
 327                   return 0;
 328                 }
 329
 330               fx.recno = lex_integer ();
 331               lex_get ();
 332             }
 333           fx.sc = 1;
 334         }
 335       fx.spec.rec = fx.recno;
 336
 337       if (!parse_DATA_LIST_vars (&fx.name, &fx.nname, PV_NONE))
 338         return 0;
 339
 340       if (token == T_NUM)
 341         {
 342           if (!fixed_parse_compatible ())
 343             goto fail;
 344         }
 345       else if (token == '(')
 346         {
 347           fx.level = 0;
 348           fx.cname = 0;
 349           if (!fixed_parse_fortran ())
 350             goto fail;
 351         }
 352       else
 353         {
 354           msg (SE, _("SPSS-like or FORTRAN-like format "
 355                "specification expected after variable names."));
 356           goto fail;
 357         }
 358
 359       for (i = 0; i < fx.nname; i++)
 360         free (fx.name[i]);
 361       free (fx.name);
 362     }
 363   if (dls.nrec && next->rec > dls.nrec)
 364     {
 365       msg (SE, _("Variables are specified on records that "
 366                  "should not exist according to RECORDS subcommand."));
 367       return 0;
 368     }
 369   else if (!dls.nrec)
 370     dls.nrec = next->rec;
 371   if (token != '.')
 372     {
 373       lex_error (_("expecting end of command"));
 374       return 0;
 375     }
 376   return 1;
 377
 378 fail:
 379   for (i = 0; i < fx.nname; i++)
 380     free (fx.name[i]);
 381   free (fx.name);
 382   return 0;
 383 }
 384
 385 static int
 386 fixed_parse_compatible (void)
 387 {
 388   int dividend;
 389   int i;
 390
 391   if (!lex_force_int ())
 392     return 0;
 393
 394   fx.fc = lex_integer ();
 395   if (fx.fc < 1)
 396     {
 397       msg (SE, _("Column positions for fields must be positive."));
 398       return 0;
 399     }
 400   lex_get ();
 401
 402   lex_negative_to_dash ();
 403   if (lex_match ('-'))
 404     {
 405       if (!lex_force_int ())
 406         return 0;
 407       fx.lc = lex_integer ();
 408       if (fx.lc < 1)
 409         {
 410           msg (SE, _("Column positions for fields must be positive."));
 411           return 0;
 412         }
 413       else if (fx.lc < fx.fc)
 414         {
 415           msg (SE, _("The ending column for a field must be "
 416                      "greater than the starting column."));
 417           return 0;
 418         }
 419
 420       lex_get ();
 421     }
 422   else
 423     fx.lc = fx.fc;
 424
 425   fx.spec.input.w = fx.lc - fx.fc + 1;
 426   if (lex_match ('('))
 427     {
 428       struct fmt_desc *fdp;
 429
 430       if (token == T_ID)
 431         {
 432           const char *cp;
 433
 434           fx.spec.input.type = parse_format_specifier_name (&cp, 0);
 435           if (fx.spec.input.type == -1)
 436             return 0;
 437           if (*cp)
 438             {
 439               msg (SE, _("A format specifier on this line "
 440                          "has extra characters on the end."));
 441               return 0;
 442             }
 443
 444           lex_get ();
 445           lex_match (',');
 446         }
 447       else
 448         fx.spec.input.type = FMT_F;
 449
 450       if (lex_integer_p ())
 451         {
 452           if (lex_integer () < 1)
 453             {
 454               msg (SE, _("The value for number of decimal places "
 455                          "must be at least 1."));
 456               return 0;
 457             }
 458
 459           fx.spec.input.d = lex_integer ();
 460           lex_get ();
 461         }
 462       else
 463         fx.spec.input.d = 0;
 464
 465       fdp = &formats[fx.spec.input.type];
 466       if (fdp->n_args < 2 && fx.spec.input.d)
 467         {
 468           msg (SE, _("Input format %s doesn't accept decimal places."),
 469                fdp->name);
 470           return 0;
 471         }
 472
 473       if (fx.spec.input.d > 16)
 474         fx.spec.input.d = 16;
 475
 476       if (!lex_force_match (')'))
 477         return 0;
 478     }
 479   else
 480     {
 481       fx.spec.input.type = FMT_F;
 482       fx.spec.input.d = 0;
 483     }
 484
 485   fx.sc = fx.lc + 1;
 486
 487   if ((fx.lc - fx.fc + 1) % fx.nname)
 488     {
 489       msg (SE, _("The %d columns %d-%d "
 490                  "can't be evenly divided into %d fields."),
 491            fx.lc - fx.fc + 1, fx.fc, fx.lc, fx.nname);
 492       return 0;
 493     }
 494
 495   dividend = (fx.lc - fx.fc + 1) / fx.nname;
 496   fx.spec.input.w = dividend;
 497   if (!check_input_specifier (&fx.spec.input))
 498     return 0;
 499
 500   for (i = 0; i < fx.nname; i++)
 501     {
 502       int type;
 503       int width;
 504       struct variable *v;
 505
 506       if (fx.spec.input.type == FMT_A || fx.spec.input.type == FMT_AHEX)
 507         {
 508           type = ALPHA;
 509           width = dividend;
 510         }
 511       else
 512         {
 513           type = NUMERIC;
 514           width = 0;
 515         }
 516
 517       v = dict_create_var (default_dict, fx.name[i], width);
 518       if (v)
 519         {
 520           convert_fmt_ItoO (&fx.spec.input, &v->print);
 521           v->write = v->print;
 522         }
 523       else
 524         {
 525           v = dict_lookup_var (default_dict, fx.name[i]);
 526           assert (v != NULL);
 527           if (!vfm_source)
 528             {
 529               msg (SE, _("%s is a duplicate variable name."), fx.name[i]);
 530               return 0;
 531             }
 532           if (type != v->type)
 533             {
 534               msg (SE, _("There is already a variable %s of a "
 535                          "different type."),
 536                    fx.name[i]);
 537               return 0;
 538             }
 539           if (type == ALPHA && dividend != v->width)
 540             {
 541               msg (SE, _("There is already a string variable %s of a "
 542                          "different width."), fx.name[i]);
 543               return 0;
 544             }
 545         }
 546
 547       fx.spec.v = v;
 548       fx.spec.fc = fx.fc + dividend * i;
 549       fx.spec.lc = fx.spec.fc + dividend - 1;
 550       fx.spec.fv = v->fv;
 551       fx.spec.width = v->width;
 552       append_var_spec (&fx.spec);
 553     }
 554   return 1;
 555 }
 556
 557 /* Destroy a format list and, optionally, all its sublists. */
 558 static void
 559 destroy_fmt_list (struct fmt_list *f, int recurse)
 560 {
 561   struct fmt_list *next;
 562
 563   for (; f; f = next)
 564     {
 565       next = f->next;
 566       if (recurse && f->f.type == FMT_DESCEND)
 567         destroy_fmt_list (f->down, 1);
 568       free (f);
 569     }
 570 }
 571
 572 /* Takes a hierarchically structured fmt_list F as constructed by
 573    fixed_parse_fortran(), and flattens it into a linear list of
 574    dls_var_spec's. */
 575 static int
 576 dump_fmt_list (struct fmt_list *f)
 577 {
 578   int i;
 579
 580   for (; f; f = f->next)
 581     if (f->f.type == FMT_X)
 582       fx.sc += f->count;
 583     else if (f->f.type == FMT_T)
 584       fx.sc = f->f.w;
 585     else if (f->f.type == FMT_NEWREC)
 586       {
 587         fx.recno += f->count;
 588         fx.sc = 1;
 589       }
 590     else
 591       for (i = 0; i < f->count; i++)
 592         if (f->f.type == FMT_DESCEND)
 593           {
 594             if (!dump_fmt_list (f->down))
 595               return 0;
 596           }
 597         else
 598           {
 599             int type;
 600             int width;
 601             struct variable *v;
 602
 603             if (formats[f->f.type].cat & FCAT_STRING)
 604               {
 605                 type = ALPHA;
 606                 width = f->f.w;
 607               }
 608             else
 609               {
 610                 type = NUMERIC;
 611                 width = 0;
 612               }
 613             if (fx.cname >= fx.nname)
 614               {
 615                 msg (SE, _("The number of format "
 616                            "specifications exceeds the number of "
 617                            "variable names given."));
 618                 return 0;
 619               }
 620
 621             fx.spec.v = v = dict_create_var (default_dict,
 622                                              fx.name[fx.cname++],
 623                                              width);
 624             if (!v)
 625               {
 626                 msg (SE, _("%s is a duplicate variable name."), fx.name[i]);
 627                 return 0;
 628               }
 629
 630             fx.spec.input = f->f;
 631             convert_fmt_ItoO (&fx.spec.input, &v->print);
 632             v->write = v->print;
 633
 634             fx.spec.rec = fx.recno;
 635             fx.spec.fc = fx.sc;
 636             fx.spec.lc = fx.sc + f->f.w - 1;
 637             fx.spec.fv = v->fv;
 638             fx.spec.width = v->width;
 639             append_var_spec (&fx.spec);
 640
 641             fx.sc += f->f.w;
 642           }
 643   return 1;
 644 }
 645
 646 /* Calls itself recursively to parse nested levels of parentheses.
 647    Returns to its original caller: NULL, to indicate error; non-NULL,
 648    but nothing useful, to indicate success (it returns a free()'d
 649    block). */
 650 static struct fmt_list *
 651 fixed_parse_fortran (void)
 652 {
 653   struct fmt_list *head;
 654   struct fmt_list *fl = NULL;
 655
 656   lex_get ();                   /* Skip opening parenthesis. */
 657   while (token != ')')
 658     {
 659       if (fl)
 660         fl = fl->next = xmalloc (sizeof *fl);
 661       else
 662         head = fl = xmalloc (sizeof *fl);
 663
 664       if (lex_integer_p ())
 665         {
 666           fl->count = lex_integer ();
 667           lex_get ();
 668         }
 669       else
 670         fl->count = 1;
 671
 672       if (token == '(')
 673         {
 674           fl->f.type = FMT_DESCEND;
 675           fx.level++;
 676           fl->down = fixed_parse_fortran ();
 677           fx.level--;
 678           if (!fl->down)
 679             goto fail;
 680         }
 681       else if (lex_match ('/'))
 682         fl->f.type = FMT_NEWREC;
 683       else if (!parse_format_specifier (&fl->f, 1)
 684                || !check_input_specifier (&fl->f))
 685         goto fail;
 686
 687       lex_match (',');
 688     }
 689   fl->next = NULL;
 690   lex_get ();
 691
 692   if (fx.level)
 693     return head;
 694
 695   fl->next = NULL;
 696   dump_fmt_list (head);
 697   if (fx.cname < fx.nname)
 698     {
 699       msg (SE, _("There aren't enough format specifications "
 700            "to match the number of variable names given."));
 701       goto fail;
 702     }
 703   destroy_fmt_list (head, 1);
 704   return head;
 705
 706 fail:
 707   fl->next = NULL;
 708   destroy_fmt_list (head, 0);
 709
 710   return NULL;
 711 }
 712
 713 /* Displays a table giving information on fixed-format variable
 714    parsing on DATA LIST. */
 715 /* FIXME: The `Columns' column should be divided into three columns,
 716    one for the starting column, one for the dash, one for the ending
 717    column; then right-justify the starting column and left-justify the
 718    ending column. */
 719 static void
 720 dump_fixed_table (void)
 721 {
 722   struct dls_var_spec *spec;
 723   struct tab_table *t;
 724   char *buf;
 725   const char *filename;
 726   int i;
 727
 728   for (i = 0, spec = *first; spec; spec = spec->next)
 729     i++;
 730   t = tab_create (4, i + 1, 0);
 731   tab_columns (t, TAB_COL_DOWN, 1);
 732   tab_headers (t, 0, 0, 1, 0);
 733   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 734   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
 735   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
 736   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 737   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, i);
 738   tab_hline (t, TAL_2, 0, 3, 1);
 739   tab_dim (t, tab_natural_dimensions);
 740
 741   for (i = 1, spec = *first; spec; spec = spec->next, i++)
 742     {
 743       tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 744       tab_text (t, 1, i, TAT_PRINTF, "%d", spec->rec);
 745       tab_text (t, 2, i, TAT_PRINTF, "%3d-%3d",
 746                     spec->fc, spec->lc);
 747       tab_text (t, 3, i, TAB_LEFT | TAT_FIX,
 748                     fmt_to_string (&spec->input));
 749     }
 750
 751   if (*first == dls.spec)
 752     {
 753       filename = fh_handle_name (dls.handle);
 754       if (filename == NULL)
 755         filename = "";
 756       buf = local_alloc (strlen (filename) + INT_DIGITS + 80);
 757       sprintf (buf, (dls.handle != inline_file
 758                      ?
 759                      ngettext("Reading %d record from file %s.",
 760                               "Reading %d records from file %s.",dls.nrec)
 761                      :
 762                      ngettext("Reading %d record from the command file.",
 763                               "Reading %d records from the command file.",
 764                               dls.nrec)),
 765                dls.nrec, filename);
 766     }
 767   else
 768     {
 769       buf = local_alloc (strlen (_("Occurrence data specifications.")) + 1);
 770       strcpy (buf, _("Occurrence data specifications."));
 771     }
 772
 773   tab_title (t, 0, buf);
 774   tab_submit (t);
 775   fh_handle_name (NULL);
 776   local_free (buf);
 777 }
 778 \f
 779 /* Free-format parsing. */
 780
 781 static int
 782 parse_free (void)
 783 {
 784   struct dls_var_spec spec;
 785   struct fmt_spec in, out;
 786   char **name;
 787   int nname;
 788   int i;
 789
 790   lex_get ();
 791   while (token != '.')
 792     {
 793       int width;
 794
 795       if (!parse_DATA_LIST_vars (&name, &nname, PV_NONE))
 796         return 0;
 797       if (lex_match ('('))
 798         {
 799           if (!parse_format_specifier (&in, 0) || !check_input_specifier (&in))
 800             goto fail;
 801           if (!lex_force_match (')'))
 802             goto fail;
 803           convert_fmt_ItoO (&in, &out);
 804         }
 805       else
 806         {
 807           lex_match ('*');
 808           in.type = FMT_F;
 809           in.w = 8;
 810           in.d = 0;
 811           out = set_format;
 812         }
 813
 814       spec.input = in;
 815       if (in.type == FMT_A || in.type == FMT_AHEX)
 816         width = in.w;
 817       else
 818         width = 0;
 819       for (i = 0; i < nname; i++)
 820         {
 821           struct variable *v;
 822
 823           spec.v = v = dict_create_var (default_dict, name[i], width);
 824           if (!v)
 825             {
 826               msg (SE, _("%s is a duplicate variable name."), name[i]);
 827               return 0;
 828             }
 829
 830           v->print = v->write = out;
 831
 832           strcpy (spec.name, name[i]);
 833           spec.fv = v->fv;
 834           spec.width = width;
 835           append_var_spec (&spec);
 836         }
 837       for (i = 0; i < nname; i++)
 838         free (name[i]);
 839       free (name);
 840     }
 841
 842   if (token != '.')
 843     lex_error (_("expecting end of command"));
 844   return 1;
 845
 846 fail:
 847   for (i = 0; i < nname; i++)
 848     free (name[i]);
 849   free (name);
 850   return 0;
 851 }
 852
 853 /* Displays a table giving information on free-format variable parsing
 854    on DATA LIST. */
 855 static void
 856 dump_free_table (void)
 857 {
 858   struct tab_table *t;
 859   int i;
 860
 861   {
 862     struct dls_var_spec *spec;
 863     for (i = 0, spec = dls.spec; spec; spec = spec->next)
 864       i++;
 865   }
 866
 867   t = tab_create (2, i + 1, 0);
 868   tab_columns (t, TAB_COL_DOWN, 1);
 869   tab_headers (t, 0, 0, 1, 0);
 870   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 871   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 872   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
 873   tab_hline (t, TAL_2, 0, 1, 1);
 874   tab_dim (t, tab_natural_dimensions);
 875
 876   {
 877     struct dls_var_spec *spec;
 878
 879     for (i = 1, spec = dls.spec; spec; spec = spec->next, i++)
 880       {
 881         tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 882         tab_text (t, 1, i, TAB_LEFT | TAT_FIX, fmt_to_string (&spec->input));
 883       }
 884   }
 885
 886   {
 887     const char *filename;
 888
 889     filename = fh_handle_name (dls.handle);
 890     if (filename == NULL)
 891       filename = "";
 892     tab_title (t, 1,
 893                (dls.handle != inline_file
 894                 ? _("Reading free-form data from file %s.")
 895                 : _("Reading free-form data from the command file.")),
 896                filename);
 897   }
 898
 899   tab_submit (t);
 900   fh_handle_name (NULL);
 901 }
 902 \f
 903 /* Input procedure. */
 904
 905 /* Pointer to relevant parsing data.  Static just to avoid passing it
 906    around so much. */
 907 static struct data_list_pgm *dlsp;
 908
 909 /* Extracts a field from the current position in the current record.
 910    Fields can be unquoted or quoted with single- or double-quote
 911    characters.  *RET_LEN is set to the field length, *RET_CP is set to
 912    the field itself.  After parsing the field, sets the current
 913    position in the record to just past the field.  Returns 0 on
 914    failure or a 1-based column number indicating the beginning of the
 915    field on success. */
 916 static int
 917 cut_field (char **ret_cp, int *ret_len)
 918 {
 919   char *cp, *ep;
 920   int len;
 921
 922   cp = dfm_get_record (dlsp->handle, &len);
 923   if (!cp)
 924     return 0;
 925
 926   ep = cp + len;
 927
 928   /* Skip leading whitespace and commas. */
 929   while ((isspace ((unsigned char) *cp) || *cp == ',') && cp < ep)
 930     cp++;
 931   if (cp >= ep)
 932     return 0;
 933
 934   /* Three types of fields: quoted with ', quoted with ", unquoted. */
 935   if (*cp == '\'' || *cp == '"')
 936     {
 937       int quote = *cp;
 938
 939       *ret_cp = ++cp;
 940       while (cp < ep && *cp != quote)
 941         cp++;
 942       *ret_len = cp - *ret_cp;
 943       if (cp < ep)
 944         cp++;
 945       else
 946         msg (SW, _("Scope of string exceeds line."));
 947     }
 948   else
 949     {
 950       *ret_cp = cp;
 951       while (cp < ep && !isspace ((unsigned char) *cp) && *cp != ',')
 952         cp++;
 953       *ret_len = cp - *ret_cp;
 954     }
 955
 956   {
 957     int beginning_column;
 958
 959     dfm_set_record (dlsp->handle, *ret_cp);
 960     beginning_column = dfm_get_cur_col (dlsp->handle) + 1;
 961
 962     dfm_set_record (dlsp->handle, cp);
 963
 964     return beginning_column;
 965   }
 966 }
 967
 968 static int read_from_data_list_fixed (void);
 969 static int read_from_data_list_free (void);
 970 static int read_from_data_list_list (void);
 971
 972 /* FLAG==0: reads any number of cases into temp_case and calls
 973    write_case() for each one, returns garbage.  FLAG!=0: reads one
 974    case into temp_case and returns -2 on eof, -1 otherwise.
 975    Uses dlsp as the relevant parsing description. */
 976 static int
 977 do_reading (int flag, write_case_func *write_case, write_case_data wc_data)
 978 {
 979   int (*func) (void);
 980
 981   int code;
 982
 983   dfm_push (dlsp->handle);
 984
 985   switch (dlsp->type)
 986     {
 987     case DLS_FIXED:
 988       func = read_from_data_list_fixed;
 989       break;
 990     case DLS_FREE:
 991       func = read_from_data_list_free;
 992       break;
 993     case DLS_LIST:
 994       func = read_from_data_list_list;
 995       break;
 996     default:
 997       assert (0);
 998     }
 999   if (flag)
1000     {
1001       code = func ();
1002       if (code == -2)
1003         {
1004           if (dlsp->eof == 1)
1005             {
1006               msg (SE, _("Attempt to read past end of file."));
1007               err_failure ();
1008               return -2;
1009             }
1010           dlsp->eof = 1;
1011         }
1012       else
1013         dlsp->eof = 0;
1014
1015       if (dlsp->end != NULL)
1016         {
1017           if (code == -2)
1018             {
1019               printf ("end of file, setting %s to 1\n", dlsp->end->name);
1020               temp_case->data[dlsp->end->fv].f = 1.0;
1021               code = -1;
1022             }
1023           else
1024             {
1025               printf ("not end of file, setting %s to 0\n", dlsp->end->name);
1026               temp_case->data[dlsp->end->fv].f = 0.0;
1027             }
1028         }
1029     }
1030   else
1031     {
1032       while (func () != -2)
1033         if (!write_case (wc_data))
1034           {
1035             debug_printf ((_("abort in write_case()\n")));
1036             break;
1037           }
1038       fh_close_handle (dlsp->handle);
1039     }
1040   dfm_pop (dlsp->handle);
1041
1042   return code;
1043 }
1044
1045 /* Reads a case from the data file and parses it according to
1046    fixed-format syntax rules. */
1047 static int
1048 read_from_data_list_fixed (void)
1049 {
1050   struct dls_var_spec *var_spec = dlsp->spec;
1051   int i;
1052
1053   if (!dfm_get_record (dlsp->handle, NULL))
1054     return -2;
1055   for (i = 1; i <= dlsp->nrec; i++)
1056     {
1057       int len;
1058       char *line = dfm_get_record (dlsp->handle, &len);
1059
1060       if (!line)
1061         {
1062           /* Note that this can't occur on the first record. */
1063           msg (SW, _("Partial case of %d of %d records discarded."),
1064                i - 1, dlsp->nrec);
1065           return -2;
1066         }
1067
1068       for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
1069         {
1070           struct data_in di;
1071
1072           data_in_finite_line (&di, line, len, var_spec->fc, var_spec->lc);
1073           di.v = &temp_case->data[var_spec->fv];
1074           di.flags = 0;
1075           di.f1 = var_spec->fc;
1076           di.format = var_spec->input;
1077
1078           data_in (&di);
1079         }
1080
1081       dfm_fwd_record (dlsp->handle);
1082     }
1083
1084   return -1;
1085 }
1086
1087 /* Reads a case from the data file and parses it according to
1088    free-format syntax rules. */
1089 static int
1090 read_from_data_list_free (void)
1091 {
1092   struct dls_var_spec *var_spec;
1093   char *field;
1094   int len;
1095
1096   for (var_spec = dlsp->spec; var_spec; var_spec = var_spec->next)
1097     {
1098       int column;
1099
1100       /* Cut out a field and read in a new record if necessary. */
1101       for (;;)
1102         {
1103           column = cut_field (&field, &len);
1104           if (column != 0)
1105             break;
1106
1107           if (dfm_get_record (dlsp->handle, NULL))
1108             dfm_fwd_record (dlsp->handle);
1109           if (!dfm_get_record (dlsp->handle, NULL))
1110             {
1111               if (var_spec != dlsp->spec)
1112                 msg (SW, _("Partial case discarded.  The first variable "
1113                      "missing was %s."), var_spec->name);
1114               return -2;
1115             }
1116         }
1117
1118       {
1119         struct data_in di;
1120
1121         di.s = field;
1122         di.e = field + len;
1123         di.v = &temp_case->data[var_spec->fv];
1124         di.flags = 0;
1125         di.f1 = column;
1126         di.format = var_spec->input;
1127         data_in (&di);
1128       }
1129     }
1130   return -1;
1131 }
1132
1133 /* Reads a case from the data file and parses it according to
1134    list-format syntax rules. */
1135 static int
1136 read_from_data_list_list (void)
1137 {
1138   struct dls_var_spec *var_spec;
1139   char *field;
1140   int len;
1141
1142   if (!dfm_get_record (dlsp->handle, NULL))
1143     return -2;
1144
1145   for (var_spec = dlsp->spec; var_spec; var_spec = var_spec->next)
1146     {
1147       /* Cut out a field and check for end-of-line. */
1148       int column = cut_field (&field, &len);
1149
1150       if (column == 0)
1151         {
1152           if (set_undefined)
1153             msg (SW, _("Missing value(s) for all variables from %s onward.  "
1154                  "These will be filled with the system-missing value "
1155                  "or blanks, as appropriate."),
1156                  var_spec->name);
1157           for (; var_spec; var_spec = var_spec->next)
1158             if (var_spec->width == 0)
1159               temp_case->data[var_spec->fv].f = SYSMIS;
1160             else
1161               memset (temp_case->data[var_spec->fv].s, ' ', var_spec->width);
1162           break;
1163         }
1164
1165       {
1166         struct data_in di;
1167
1168         di.s = field;
1169         di.e = field + len;
1170         di.v = &temp_case->data[var_spec->fv];
1171         di.flags = 0;
1172         di.f1 = column;
1173         di.format = var_spec->input;
1174         data_in (&di);
1175       }
1176     }
1177
1178   dfm_fwd_record (dlsp->handle);
1179   return -1;
1180 }
1181
1182 /* Destroys DATA LIST transformation or input program PGM. */
1183 static void
1184 destroy_dls (struct trns_header *pgm)
1185 {
1186   struct data_list_pgm *dls = (struct data_list_pgm *) pgm;
1187   struct dls_var_spec *iter, *next;
1188
1189   iter = dls->spec;
1190   while (iter)
1191     {
1192       next = iter->next;
1193       free (iter);
1194       iter = next;
1195     }
1196   fh_close_handle (dls->handle);
1197 }
1198
1199 /* Note that since this is exclusively an input program, C is
1200    guaranteed to be temp_case. */
1201 static int
1202 read_one_case (struct trns_header *t, struct ccase *c UNUSED)
1203 {
1204   dlsp = (struct data_list_pgm *) t;
1205   return do_reading (1, NULL, NULL);
1206 }
1207 \f
1208 /* Reads all the records from the data file and passes them to
1209    write_case(). */
1210 static void
1211 data_list_source_read (write_case_func *write_case, write_case_data wc_data)
1212 {
1213   dlsp = &dls;
1214   do_reading (0, write_case, wc_data);
1215 }
1216
1217 /* Destroys the source's internal data. */
1218 static void
1219 data_list_source_destroy_source (void)
1220 {
1221   destroy_dls ((struct trns_header *) & dls);
1222 }
1223
1224 struct case_stream data_list_source =
1225   {
1226     NULL,
1227     data_list_source_read,
1228     NULL,
1229     NULL,
1230     data_list_source_destroy_source,
1231     NULL,
1232     "DATA LIST",
1233   };
1234 \f
1235 /* REPEATING DATA. */
1236
1237 /* Represents a number or a variable. */
1238 struct rpd_num_or_var
1239   {
1240     int num;                    /* Value, or 0. */
1241     struct variable *var;       /* Variable, if number==0. */
1242   };
1243
1244 /* REPEATING DATA private data structure. */
1245 struct repeating_data_trns
1246   {
1247     struct trns_header h;
1248     struct dls_var_spec *spec;  /* Variable parsing specifications. */
1249     struct file_handle *handle; /* Input file, never NULL. */
1250     /* Do not reorder preceding fields. */
1251
1252     struct rpd_num_or_var starts_beg;   /* STARTS=, before the dash. */
1253     struct rpd_num_or_var starts_end;   /* STARTS=, after the dash. */
1254     struct rpd_num_or_var occurs;       /* OCCURS= subcommand. */
1255     struct rpd_num_or_var length;       /* LENGTH= subcommand. */
1256     struct rpd_num_or_var cont_beg;     /* CONTINUED=, before the dash. */
1257     struct rpd_num_or_var cont_end;     /* CONTINUED=, after the dash. */
1258     int id_beg, id_end;                 /* ID subcommand, beginning & end columns. */
1259     struct variable *id_var;            /* ID subcommand, DATA LIST variable. */
1260     struct fmt_spec id_spec;            /* ID subcommand, input format spec. */
1261     write_case_func *write_case;
1262     write_case_data wc_data;
1263   };
1264
1265 /* Information about the transformation being parsed. */
1266 static struct repeating_data_trns rpd;
1267
1268 int repeating_data_trns_proc (struct trns_header *, struct ccase *);
1269 static int parse_num_or_var (struct rpd_num_or_var *, const char *);
1270 static int parse_repeating_data (void);
1271 static void find_variable_input_spec (struct variable *v,
1272                                       struct fmt_spec *spec);
1273
1274 /* Parses the REPEATING DATA command. */
1275 int
1276 cmd_repeating_data (void)
1277 {
1278   /* 0=print no table, 1=print table.  (TABLE subcommand.)  */
1279   int table = 1;
1280
1281   /* Bits are set when a particular subcommand has been seen. */
1282   unsigned seen = 0;
1283
1284   lex_match_id ("REPEATING");
1285   lex_match_id ("DATA");
1286
1287   assert (vfm_source == &input_program_source
1288           || vfm_source == &file_type_source);
1289
1290   rpd.handle = default_handle;
1291   rpd.starts_beg.num = 0;
1292   rpd.starts_beg.var = NULL;
1293   rpd.starts_end = rpd.occurs = rpd.length = rpd.cont_beg
1294     = rpd.cont_end = rpd.starts_beg;
1295   rpd.id_beg = rpd.id_end = 0;
1296   rpd.id_var = NULL;
1297   rpd.spec = NULL;
1298   first = &rpd.spec;
1299   next = NULL;
1300
1301   lex_match ('/');
1302
1303   for (;;)
1304     {
1305       if (lex_match_id ("FILE"))
1306         {
1307           lex_match ('=');
1308           rpd.handle = fh_parse_file_handle ();
1309           if (!rpd.handle)
1310             return CMD_FAILURE;
1311           if (rpd.handle != default_handle)
1312             {
1313               msg (SE, _("REPEATING DATA must use the same file as its "
1314                          "corresponding DATA LIST or FILE TYPE."));
1315               return CMD_FAILURE;
1316             }
1317         }
1318       else if (lex_match_id ("STARTS"))
1319         {
1320           lex_match ('=');
1321           if (seen & 1)
1322             {
1323               msg (SE, _("%s subcommand given multiple times."),"STARTS");
1324               return CMD_FAILURE;
1325             }
1326           seen |= 1;
1327
1328           if (!parse_num_or_var (&rpd.starts_beg, "STARTS beginning column"))
1329             return CMD_FAILURE;
1330
1331           lex_negative_to_dash ();
1332           if (lex_match ('-'))
1333             {
1334               if (!parse_num_or_var (&rpd.starts_end, "STARTS ending column"))
1335                 return CMD_FAILURE;
1336             } else {
1337               /* Otherwise, rpd.starts_end is left uninitialized.
1338                  This is okay.  We will initialize it later from the
1339                  record length of the file.  We can't do this now
1340                  because we can't be sure that the user has specified
1341                  the file handle yet. */
1342             }
1343
1344           if (rpd.starts_beg.num != 0 && rpd.starts_end.num != 0
1345               && rpd.starts_beg.num > rpd.starts_end.num)
1346             {
1347               msg (SE, _("STARTS beginning column (%d) exceeds "
1348                          "STARTS ending column (%d)."),
1349                    rpd.starts_beg.num, rpd.starts_end.num);
1350               return CMD_FAILURE;
1351             }
1352         }
1353       else if (lex_match_id ("OCCURS"))
1354         {
1355           lex_match ('=');
1356           if (seen & 2)
1357             {
1358               msg (SE, _("%s subcommand given multiple times."),"OCCURS");
1359               return CMD_FAILURE;
1360             }
1361           seen |= 2;
1362
1363           if (!parse_num_or_var (&rpd.occurs, "OCCURS"))
1364             return CMD_FAILURE;
1365         }
1366       else if (lex_match_id ("LENGTH"))
1367         {
1368           lex_match ('=');
1369           if (seen & 4)
1370             {
1371               msg (SE, _("%s subcommand given multiple times."),"LENGTH");
1372               return CMD_FAILURE;
1373             }
1374           seen |= 4;
1375
1376           if (!parse_num_or_var (&rpd.length, "LENGTH"))
1377             return CMD_FAILURE;
1378         }
1379       else if (lex_match_id ("CONTINUED"))
1380         {
1381           lex_match ('=');
1382           if (seen & 8)
1383             {
1384               msg (SE, _("%s subcommand given multiple times."),"CONTINUED");
1385               return CMD_FAILURE;
1386             }
1387           seen |= 8;
1388
1389           if (!lex_match ('/'))
1390             {
1391               if (!parse_num_or_var (&rpd.cont_beg, "CONTINUED beginning column"))
1392                 return CMD_FAILURE;
1393
1394               lex_negative_to_dash ();
1395               if (lex_match ('-')
1396                   && !parse_num_or_var (&rpd.cont_end,
1397                                         "CONTINUED ending column"))
1398                 return CMD_FAILURE;
1399
1400               if (rpd.cont_beg.num != 0 && rpd.cont_end.num != 0
1401                   && rpd.cont_beg.num > rpd.cont_end.num)
1402                 {
1403                   msg (SE, _("CONTINUED beginning column (%d) exceeds "
1404                              "CONTINUED ending column (%d)."),
1405                        rpd.cont_beg.num, rpd.cont_end.num);
1406                   return CMD_FAILURE;
1407                 }
1408             }
1409           else
1410             rpd.cont_beg.num = 1;
1411         }
1412       else if (lex_match_id ("ID"))
1413         {
1414           lex_match ('=');
1415           if (seen & 16)
1416             {
1417               msg (SE, _("%s subcommand given multiple times."),"ID");
1418               return CMD_FAILURE;
1419             }
1420           seen |= 16;
1421
1422           if (!lex_force_int ())
1423             return CMD_FAILURE;
1424           if (lex_integer () < 1)
1425             {
1426               msg (SE, _("ID beginning column (%ld) must be positive."),
1427                    lex_integer ());
1428               return CMD_FAILURE;
1429             }
1430           rpd.id_beg = lex_integer ();
1431
1432           lex_get ();
1433           lex_negative_to_dash ();
1434
1435           if (lex_match ('-'))
1436             {
1437               if (!lex_force_int ())
1438                 return CMD_FAILURE;
1439               if (lex_integer () < 1)
1440                 {
1441                   msg (SE, _("ID ending column (%ld) must be positive."),
1442                        lex_integer ());
1443                   return CMD_FAILURE;
1444                 }
1445               if (lex_integer () < rpd.id_end)
1446                 {
1447                   msg (SE, _("ID ending column (%ld) cannot be less than "
1448                              "ID beginning column (%d)."),
1449                        lex_integer (), rpd.id_beg);
1450                   return CMD_FAILURE;
1451                 }
1452
1453               rpd.id_end = lex_integer ();
1454               lex_get ();
1455             }
1456           else rpd.id_end = rpd.id_beg;
1457
1458           if (!lex_force_match ('='))
1459             return CMD_FAILURE;
1460           rpd.id_var = parse_variable ();
1461           if (rpd.id_var == NULL)
1462             return CMD_FAILURE;
1463
1464           find_variable_input_spec (rpd.id_var, &rpd.id_spec);
1465         }
1466       else if (lex_match_id ("TABLE"))
1467         table = 1;
1468       else if (lex_match_id ("NOTABLE"))
1469         table = 0;
1470       else if (lex_match_id ("DATA"))
1471         break;
1472       else
1473         {
1474           lex_error (NULL);
1475           return CMD_FAILURE;
1476         }
1477
1478       if (!lex_force_match ('/'))
1479         return CMD_FAILURE;
1480     }
1481
1482   /* Comes here when DATA specification encountered. */
1483   if ((seen & (1 | 2)) != (1 | 2))
1484     {
1485       if ((seen & 1) == 0)
1486         msg (SE, _("Missing required specification STARTS."));
1487       if ((seen & 2) == 0)
1488         msg (SE, _("Missing required specification OCCURS."));
1489       return CMD_FAILURE;
1490     }
1491
1492   /* Enforce ID restriction. */
1493   if ((seen & 16) && !(seen & 8))
1494     {
1495       msg (SE, _("ID specified without CONTINUED."));
1496       return CMD_FAILURE;
1497     }
1498
1499   /* Calculate starts_end, cont_end if necessary. */
1500   if (rpd.starts_end.num == 0 && rpd.starts_end.var == NULL)
1501     rpd.starts_end.num = fh_record_width (rpd.handle);
1502   if (rpd.cont_end.num == 0 && rpd.starts_end.var == NULL)
1503     rpd.cont_end.num = fh_record_width (rpd.handle);
1504
1505   /* Calculate length if possible. */
1506   if ((seen & 4) == 0)
1507     {
1508       struct dls_var_spec *iter;
1509
1510       for (iter = rpd.spec; iter; iter = iter->next)
1511         {
1512           if (iter->lc > rpd.length.num)
1513             rpd.length.num = iter->lc;
1514         }
1515       assert (rpd.length.num != 0);
1516     }
1517
1518   lex_match ('=');
1519   if (!parse_repeating_data ())
1520     return CMD_FAILURE;
1521
1522   if (table)
1523     dump_fixed_table ();
1524
1525   {
1526     struct repeating_data_trns *new_trns;
1527
1528     rpd.h.proc = repeating_data_trns_proc;
1529     rpd.h.free = destroy_dls;
1530
1531     new_trns = xmalloc (sizeof *new_trns);
1532     memcpy (new_trns, &rpd, sizeof *new_trns);
1533     add_transformation ((struct trns_header *) new_trns);
1534   }
1535
1536   return lex_end_of_command ();
1537 }
1538
1539 /* Because of the way that DATA LIST is structured, it's not trivial
1540    to determine what input format is associated with a given variable.
1541    This function finds the input format specification for variable V
1542    and puts it in SPEC. */
1543 static void
1544 find_variable_input_spec (struct variable *v, struct fmt_spec *spec)
1545 {
1546   int i;
1547
1548   for (i = 0; i < n_trns; i++)
1549     {
1550       struct data_list_pgm *pgm = (struct data_list_pgm *) t_trns[i];
1551
1552       if (pgm->h.proc == read_one_case)
1553         {
1554           struct dls_var_spec *iter;
1555
1556           for (iter = pgm->spec; iter; iter = iter->next)
1557             if (iter->v == v)
1558               {
1559                 *spec = iter->input;
1560                 return;
1561               }
1562         }
1563     }
1564
1565   assert (0);
1566 }
1567
1568 /* Parses a number or a variable name from the syntax file and puts
1569    the results in VALUE.  Ensures that the number is at least 1; else
1570    emits an error based on MESSAGE.  Returns nonzero only if
1571    successful. */
1572 static int
1573 parse_num_or_var (struct rpd_num_or_var *value, const char *message)
1574 {
1575   if (token == T_ID)
1576     {
1577       value->num = 0;
1578       value->var = parse_variable ();
1579       if (value->var == NULL)
1580         return 0;
1581       if (value->var->type == ALPHA)
1582         {
1583           msg (SE, _("String variable not allowed here."));
1584           return 0;
1585         }
1586     }
1587   else if (lex_integer_p ())
1588     {
1589       value->num = lex_integer ();
1590
1591       if (value->num < 1)
1592         {
1593           msg (SE, _("%s (%d) must be at least 1."), message, value->num);
1594           return 0;
1595         }
1596
1597       lex_get ();
1598     } else {
1599       msg (SE, _("Variable or integer expected for %s."), message);
1600       return 0;
1601     }
1602   return 1;
1603 }
1604
1605 /* Parses data specifications for repeating data groups.  Taken from
1606    parse_fixed().  Returns nonzero only if successful.  */
1607 static int
1608 parse_repeating_data (void)
1609 {
1610   int i;
1611
1612   fx.recno = 0;
1613   fx.sc = 1;
1614
1615   while (token != '.')
1616     {
1617       fx.spec.rec = fx.recno;
1618
1619       if (!parse_DATA_LIST_vars (&fx.name, &fx.nname, PV_NONE))
1620         return 0;
1621
1622       if (token == T_NUM)
1623         {
1624           if (!fixed_parse_compatible ())
1625             goto fail;
1626         }
1627       else if (token == '(')
1628         {
1629           fx.level = 0;
1630           fx.cname = 0;
1631           if (!fixed_parse_fortran ())
1632             goto fail;
1633         }
1634       else
1635         {
1636           msg (SE, _("SPSS-like or FORTRAN-like format "
1637                "specification expected after variable names."));
1638           goto fail;
1639         }
1640
1641       for (i = 0; i < fx.nname; i++)
1642         free (fx.name[i]);
1643       free (fx.name);
1644     }
1645   if (token != '.')
1646     {
1647       lex_error (_("expecting end of command"));
1648       return 0;
1649     }
1650
1651   return 1;
1652
1653 fail:
1654   for (i = 0; i < fx.nname; i++)
1655     free (fx.name[i]);
1656   free (fx.name);
1657   return 0;
1658 }
1659
1660 /* Obtains the real value for rpd_num_or_var N in case C and returns
1661    it.  The valid range is nonnegative numbers, but numbers outside
1662    this range can be returned and should be handled by the caller as
1663    invalid. */
1664 static int
1665 realize_value (struct rpd_num_or_var *n, struct ccase *c)
1666 {
1667   if (n->num > 0)
1668     return n->num;
1669
1670   assert (n->num == 0);
1671   if (n->var != NULL)
1672     {
1673       double v = c->data[n->var->fv].f;
1674
1675       if (v == SYSMIS || v <= INT_MIN || v >= INT_MAX)
1676         return -1;
1677       else
1678         return v;
1679     }
1680   else
1681     return 0;
1682 }
1683
1684 /* Parses one record of repeated data and outputs corresponding cases.
1685    Repeating data is present in line LINE having length LEN.
1686    Repeating data begins in column BEG and continues through column
1687    END inclusive (1-based columns); occurrences are offset OFS columns
1688    from each other.  C is the case that will be filled in; T is the
1689    REPEATING DATA transformation.  The record ID will be verified if
1690    COMPARE_ID is nonzero; if it is zero, then the record ID is
1691    initialized to the ID present in the case (assuming that ID
1692    location was specified by the user).  Returns number of occurrences
1693    parsed up to the specified maximum of MAX_OCCURS. */
1694 static int
1695 rpd_parse_record (int beg, int end, int ofs, struct ccase *c,
1696                   struct repeating_data_trns *t,
1697                   char *line, int len, int compare_id, int max_occurs)
1698 {
1699   int occurrences;
1700   int cur = beg;
1701
1702   /* Handle record ID values. */
1703   if (t->id_beg != 0)
1704     {
1705       static union value comparator;
1706       union value v;
1707
1708       {
1709         struct data_in di;
1710
1711         data_in_finite_line (&di, line, len, t->id_beg, t->id_end);
1712         di.v = &v;
1713         di.flags = 0;
1714         di.f1 = t->id_beg;
1715         di.format = t->id_spec;
1716
1717         if (!data_in (&di))
1718           return 0;
1719       }
1720
1721       if (compare_id == 0)
1722         comparator = v;
1723       else if ((t->id_var->type == NUMERIC && comparator.f != v.f)
1724                || (t->id_var->type == ALPHA
1725                    && strncmp (comparator.s, v.s, t->id_var->width)))
1726         {
1727           char comp_str [64];
1728           char v_str [64];
1729
1730           if (!data_out (comp_str, &t->id_var->print, &comparator))
1731             comp_str[0] = 0;
1732           if (!data_out (v_str, &t->id_var->print, &v))
1733             v_str[0] = 0;
1734
1735           comp_str[t->id_var->print.w] = v_str[t->id_var->print.w] = 0;
1736
1737           tmsg (SE, RPD_ERR,
1738                 _("Mismatched case ID (%s).  Expected value was %s."),
1739                 v_str, comp_str);
1740
1741           return 0;
1742         }
1743     }
1744
1745   /* Iterate over the set of expected occurrences and record each of
1746      them as a separate case.  FIXME: We need to execute any
1747      transformations that follow the current one. */
1748   {
1749     int warned = 0;
1750
1751     for (occurrences = 0; occurrences < max_occurs; )
1752       {
1753         if (cur + ofs > end + 1)
1754           break;
1755         occurrences++;
1756
1757         {
1758           struct dls_var_spec *var_spec = t->spec;
1759
1760           for (; var_spec; var_spec = var_spec->next)
1761             {
1762               int fc = var_spec->fc - 1 + cur;
1763               int lc = var_spec->lc - 1 + cur;
1764
1765               if (fc > len && !warned && var_spec->input.type != FMT_A)
1766                 {
1767                   warned = 1;
1768
1769                   tmsg (SW, RPD_ERR,
1770                         _("Variable %s starting in column %d extends "
1771                           "beyond physical record length of %d."),
1772                         var_spec->v->name, fc, len);
1773                 }
1774
1775               {
1776                 struct data_in di;
1777
1778                 data_in_finite_line (&di, line, len, fc, lc);
1779                 di.v = &c->data[var_spec->fv];
1780                 di.flags = 0;
1781                 di.f1 = fc + 1;
1782                 di.format = var_spec->input;
1783
1784                 if (!data_in (&di))
1785                   return 0;
1786               }
1787             }
1788         }
1789
1790         cur += ofs;
1791
1792         if (!t->write_case (t->wc_data))
1793           return 0;
1794       }
1795   }
1796
1797   return occurrences;
1798 }
1799
1800 /* Analogous to read_one_case; reads one set of repetitions of the
1801    elements in the REPEATING DATA structure.  Returns -1 on success,
1802    -2 on end of file or on failure. */
1803 int
1804 repeating_data_trns_proc (struct trns_header *trns, struct ccase *c)
1805 {
1806   dfm_push (dlsp->handle);
1807
1808   {
1809     struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
1810
1811     char *line;         /* Current record. */
1812     int len;            /* Length of current record. */
1813
1814     int starts_beg;     /* Starting column. */
1815     int starts_end;     /* Ending column. */
1816     int occurs;         /* Number of repetitions. */
1817     int length;         /* Length of each occurrence. */
1818     int cont_beg;       /* Starting column for continuation lines. */
1819     int cont_end;       /* Ending column for continuation lines. */
1820
1821     int occurs_left;    /* Number of occurrences remaining. */
1822
1823     int code;           /* Return value from rpd_parse_record(). */
1824
1825     int skip_first_record = 0;
1826
1827     /* Read the current record. */
1828     dfm_bkwd_record (dlsp->handle, 1);
1829     line = dfm_get_record (dlsp->handle, &len);
1830     if (line == NULL)
1831       return -2;
1832     dfm_fwd_record (dlsp->handle);
1833
1834     /* Calculate occurs, length. */
1835     occurs_left = occurs = realize_value (&t->occurs, c);
1836     if (occurs <= 0)
1837       {
1838         tmsg (SE, RPD_ERR, _("Invalid value %d for OCCURS."), occurs);
1839         return -3;
1840       }
1841     starts_beg = realize_value (&t->starts_beg, c);
1842     if (starts_beg <= 0)
1843       {
1844         tmsg (SE, RPD_ERR, _("Beginning column for STARTS (%d) must be "
1845                              "at least 1."),
1846               starts_beg);
1847         return -3;
1848       }
1849     starts_end = realize_value (&t->starts_end, c);
1850     if (starts_end < starts_beg)
1851       {
1852         tmsg (SE, RPD_ERR, _("Ending column for STARTS (%d) is less than "
1853                              "beginning column (%d)."),
1854               starts_end, starts_beg);
1855         skip_first_record = 1;
1856       }
1857     length = realize_value (&t->length, c);
1858     if (length < 0)
1859       {
1860         tmsg (SE, RPD_ERR, _("Invalid value %d for LENGTH."), length);
1861         length = 1;
1862         occurs = occurs_left = 1;
1863       }
1864     cont_beg = realize_value (&t->cont_beg, c);
1865     if (cont_beg < 0)
1866       {
1867         tmsg (SE, RPD_ERR, _("Beginning column for CONTINUED (%d) must be "
1868                              "at least 1."),
1869               cont_beg);
1870         return -2;
1871       }
1872     cont_end = realize_value (&t->cont_end, c);
1873     if (cont_end < cont_beg)
1874       {
1875         tmsg (SE, RPD_ERR, _("Ending column for CONTINUED (%d) is less than "
1876                              "beginning column (%d)."),
1877               cont_end, cont_beg);
1878         return -2;
1879       }
1880
1881     /* Parse the first record. */
1882     if (!skip_first_record)
1883       {
1884         code = rpd_parse_record (starts_beg, starts_end, length, c, t, line,
1885                                  len, 0, occurs_left);
1886         if (!code)
1887           return -2;
1888       }
1889     else if (cont_beg == 0)
1890       return -3;
1891
1892     /* Make sure, if some occurrences are left, that we have
1893        continuation records. */
1894     occurs_left -= code;
1895     if (occurs_left != 0 && cont_beg == 0)
1896       {
1897         tmsg (SE, RPD_ERR,
1898               _("Number of repetitions specified on OCCURS (%d) "
1899                 "exceed number of repetitions available in "
1900                 "space on STARTS (%d), and CONTINUED not specified."),
1901               occurs, code);
1902         return -2;
1903       }
1904
1905     /* Go on to additional records. */
1906     while (occurs_left != 0)
1907       {
1908         assert (occurs_left >= 0);
1909
1910         /* Read in another record. */
1911         line = dfm_get_record (dlsp->handle, &len);
1912         if (line == NULL)
1913           {
1914             tmsg (SE, RPD_ERR,
1915                   _("Unexpected end of file with %d repetitions "
1916                     "remaining out of %d."),
1917                   occurs_left, occurs);
1918             return -2;
1919           }
1920         dfm_fwd_record (dlsp->handle);
1921
1922         /* Parse this record. */
1923         code = rpd_parse_record (cont_beg, cont_end, length, c, t, line,
1924                                  len, 1, occurs_left);
1925         if (!code)
1926           return -2;
1927         occurs_left -= code;
1928       }
1929   }
1930
1931   dfm_pop (dlsp->handle);
1932
1933   /* FIXME: This is a kluge until we've implemented multiplexing of
1934      transformations. */
1935   return -3;
1936 }
1937
1938 /* This is a kluge.  It is only here until I have more time
1939    tocome up with something better.  It lets
1940    repeating_data_trns_proc() know how to write the cases that it
1941    composes. */
1942 void
1943 repeating_data_set_write_case (struct trns_header *trns,
1944                                write_case_func *write_case,
1945                                write_case_data wc_data)
1946 {
1947   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
1948
1949   assert (trns->proc == repeating_data_trns_proc);
1950   t->write_case = write_case;
1951   t->wc_data = wc_data;
1952 }