src/language/lexer/q2c.c

   1 /* q2c - parser generator for PSPP procedures.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3
   4    This program is free software; you can redistribute it and/or
   5    modify it under the terms of the GNU General Public License as
   6    published by the Free Software Foundation; either version 2 of the
   7    License, or (at your option) any later version.
   8
   9    This program is distributed in the hope that it will be useful, but
  10    WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12    General Public License for more details.
  13
  14    You should have received a copy of the GNU General Public License
  15    along with this program; if not, write to the Free Software
  16    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  17    02110-1301, USA. */
  18
  19 #include <assert.h>
  20 #include <ctype.h>
  21 #include <stdio.h>
  22 #include <stdlib.h>
  23 #include <stdarg.h>
  24 #include <stdbool.h>
  25 #include <string.h>
  26 #include <errno.h>
  27 #include <unistd.h>
  28
  29 /* GNU C allows the programmer to declare that certain functions take
  30    printf-like arguments, never return, etc.  Conditionalize these
  31    declarations on whether gcc is in use. */
  32 #if __GNUC__ > 1
  33 #define ATTRIBUTE(X) __attribute__ (X)
  34 #else
  35 #define ATTRIBUTE(X)
  36 #endif
  37
  38 /* Marks a function argument as possibly not used. */
  39 #define UNUSED ATTRIBUTE ((unused))
  40
  41 /* Marks a function that will never return. */
  42 #define NO_RETURN ATTRIBUTE ((noreturn))
  43
  44 /* Mark a function as taking a printf- or scanf-like format
  45    string as its FMT'th argument and that the FIRST'th argument
  46    is the first one to be checked against the format string. */
  47 #define PRINTF_FORMAT(FMT, FIRST) ATTRIBUTE ((format (__printf__, FMT, FIRST)))
  48
  49 /* Max length of an input line. */
  50 #define MAX_LINE_LEN 1024
  51
  52 /* Max token length. */
  53 #define MAX_TOK_LEN 1024
  54
  55 /* argv[0]. */
  56 static char *program_name;
  57
  58 /* Have the input and output files been opened yet? */
  59 static bool is_open;
  60
  61 /* Input, output files. */
  62 static FILE *in, *out;
  63
  64 /* Input, output file names. */
  65 static char *ifn, *ofn;
  66
  67 /* Input, output file line number. */
  68 static int ln, oln = 1;
  69
  70 /* Input line buffer, current position. */
  71 static char *buf, *cp;
  72
  73 /* Token types. */
  74 enum
  75   {
  76     T_STRING = 256,     /* String literal. */
  77     T_ID = 257          /* Identifier.  */
  78   };
  79
  80 /* Current token: either one of the above, or a single character. */
  81 static int token;
  82
  83 /* Token string value. */
  84 static char *tokstr;
  85 \f
  86 /* Utility functions. */
  87
  88 static char nullstr[] = "";
  89
  90 /* Close all open files and delete the output file, on failure. */
  91 static void
  92 finish_up (void)
  93 {
  94   if (!is_open)
  95     return;
  96   is_open = false;
  97   fclose (in);
  98   fclose (out);
  99   if (remove (ofn) == -1)
 100     fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
 101 }
 102
 103 void hcf (void) NO_RETURN;
 104
 105 /* Terminate unsuccessfully. */
 106 void
 107 hcf (void)
 108 {
 109   finish_up ();
 110   exit (EXIT_FAILURE);
 111 }
 112
 113 int fail (const char *, ...) PRINTF_FORMAT (1, 2);
 114 int error (const char *, ...) PRINTF_FORMAT (1, 2);
 115
 116 /* Output an error message and terminate unsuccessfully. */
 117 int
 118 fail (const char *format, ...)
 119 {
 120   va_list args;
 121
 122   va_start (args, format);
 123   fprintf (stderr, "%s: ", program_name);
 124   vfprintf (stderr, format, args);
 125   fprintf (stderr, "\n");
 126   va_end (args);
 127
 128   hcf ();
 129 }
 130
 131 /* Output a context-dependent error message and terminate
 132    unsuccessfully. */
 133 int
 134 error (const char *format,...)
 135 {
 136   va_list args;
 137
 138   va_start (args, format);
 139   fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
 140   vfprintf (stderr, format, args);
 141   fprintf (stderr, "\n");
 142   va_end (args);
 143
 144   hcf ();
 145 }
 146
 147 #define VME "virtual memory exhausted"
 148
 149 /* Allocate a block of SIZE bytes and return a pointer to its
 150    beginning. */
 151 static void *
 152 xmalloc (size_t size)
 153 {
 154   void *vp;
 155
 156   if (size == 0)
 157     return NULL;
 158
 159   vp = malloc (size);
 160   if (!vp)
 161     fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
 162
 163   return vp;
 164 }
 165
 166 /* Make a dynamically allocated copy of string S and return a pointer
 167    to the first character. */
 168 static char *
 169 xstrdup (const char *s)
 170 {
 171   size_t size;
 172   char *t;
 173
 174   assert (s != NULL);
 175   size = strlen (s) + 1;
 176
 177   t = malloc (size);
 178   if (!t)
 179     fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
 180
 181   memcpy (t, s, size);
 182   return t;
 183 }
 184
 185 /* Returns a pointer to one of 8 static buffers.  The buffers are used
 186    in rotation. */
 187 static char *
 188 get_buffer (void)
 189 {
 190   static char b[8][256];
 191   static int cb;
 192
 193   if (++cb >= 8)
 194     cb = 0;
 195
 196   return b[cb];
 197 }
 198
 199 /* Copies a string to a static buffer, converting it to lowercase in
 200    the process, and returns a pointer to the static buffer. */
 201 static char *
 202 st_lower (const char *s)
 203 {
 204   char *p, *cp;
 205
 206   p = cp = get_buffer ();
 207   while (*s)
 208     *cp++ = tolower ((unsigned char) (*s++));
 209   *cp++ = '\0';
 210
 211   return p;
 212 }
 213
 214 /* Copies a string to a static buffer, converting it to uppercase in
 215    the process, and returns a pointer to the static buffer. */
 216 static char *
 217 st_upper (const char *s)
 218 {
 219   char *p, *cp;
 220
 221   p = cp = get_buffer ();
 222   while (*s)
 223     *cp++ = toupper ((unsigned char) (*s++));
 224   *cp++ = '\0';
 225
 226   return p;
 227 }
 228
 229 /* Returns the address of the first non-whitespace character in S, or
 230    the address of the null terminator if none. */
 231 static char *
 232 skip_ws (const char *s)
 233 {
 234   while (isspace ((unsigned char) *s))
 235     s++;
 236   return (char *) s;
 237 }
 238
 239 /* Read one line from the input file into buf.  Lines having special
 240    formats are handled specially. */
 241 static bool
 242 get_line (void)
 243 {
 244   ln++;
 245   if (0 == fgets (buf, MAX_LINE_LEN, in))
 246     {
 247       if (ferror (in))
 248         fail ("%s: fgets: %s", ifn, strerror (errno));
 249       return false;
 250     }
 251
 252   cp = strchr (buf, '\n');
 253   if (cp != NULL)
 254     *cp = '\0';
 255
 256   cp = buf;
 257   return true;
 258 }
 259 \f
 260 /* Symbol table manager. */
 261
 262 /* Symbol table entry. */
 263 typedef struct symbol symbol;
 264 struct symbol
 265   {
 266     symbol *next;               /* Next symbol in symbol table. */
 267     char *name;                 /* Symbol name. */
 268     int unique;                 /* 1=Name must be unique in this file. */
 269     int ln;                     /* Line number of definition. */
 270     int value;                  /* Symbol value. */
 271   };
 272
 273 /* Symbol table. */
 274 symbol *symtab;
 275
 276 /* Add a symbol to the symbol table having name NAME, uniqueness
 277    UNIQUE, and value VALUE.  If a symbol having the same name is found
 278    in the symbol table, its sequence number is returned and the symbol
 279    table is not modified.  Otherwise, the symbol is added and the next
 280    available sequence number is returned. */
 281 static int
 282 add_symbol (const char *name, int unique, int value)
 283 {
 284   symbol *iter, *sym;
 285   int x;
 286
 287   sym = xmalloc (sizeof *sym);
 288   sym->name = xstrdup (name);
 289   sym->unique = unique;
 290   sym->value = value;
 291   sym->next = NULL;
 292   sym->ln = ln;
 293   if (!symtab)
 294     {
 295       symtab = sym;
 296       return 1;
 297     }
 298   iter = symtab;
 299   x = 1;
 300   for (;;)
 301     {
 302       if (!strcmp (iter->name, name))
 303         {
 304           if (iter->unique)
 305             {
 306               fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
 307                        ln, name);
 308               fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
 309                        iter->ln);
 310               hcf ();
 311             }
 312           free (sym->name);
 313           free (sym);
 314           return x;
 315         }
 316       if (!iter->next)
 317         break;
 318       iter = iter->next;
 319       x++;
 320     }
 321   iter->next = sym;
 322   return ++x;
 323 }
 324
 325 /* Finds the symbol having given sequence number X within the symbol
 326    table, and returns the associated symbol structure. */
 327 static symbol *
 328 find_symbol (int x)
 329 {
 330   symbol *iter;
 331
 332   iter = symtab;
 333   while (x > 1 && iter)
 334     {
 335       iter = iter->next;
 336       x--;
 337     }
 338   assert (iter);
 339   return iter;
 340 }
 341
 342 #if DUMP_TOKENS
 343 /* Writes a printable representation of the current token to
 344    stdout. */
 345 static void
 346 dump_token (void)
 347 {
 348   switch (token)
 349     {
 350     case T_STRING:
 351       printf ("STRING\t\"%s\"\n", tokstr);
 352       break;
 353     case T_ID:
 354       printf ("ID\t%s\n", tokstr);
 355       break;
 356     default:
 357       printf ("PUNCT\t%c\n", token);
 358     }
 359 }
 360 #endif /* DUMP_TOKENS */
 361
 362 /* Reads a token from the input file. */
 363 static int
 364 lex_get (void)
 365 {
 366   /* Skip whitespace and check for end of file. */
 367   for (;;)
 368     {
 369       cp = skip_ws (cp);
 370       if (*cp != '\0')
 371         break;
 372
 373       if (!get_line ())
 374         fail ("%s: Unexpected end of file.", ifn);
 375     }
 376
 377   if (*cp == '"')
 378     {
 379       char *dest = tokstr;
 380       token = T_STRING;
 381       cp++;
 382       while (*cp != '"' && *cp)
 383         {
 384           if (*cp == '\\')
 385             {
 386               cp++;
 387               if (!*cp)
 388                 error ("Unterminated string literal.");
 389               *dest++ = *cp++;
 390             }
 391           else
 392             *dest++ = *cp++;
 393         }
 394       *dest++ = 0;
 395       if (!*cp)
 396         error ("Unterminated string literal.");
 397       cp++;
 398     }
 399   else if (*cp == '_' || isalnum ((unsigned char) *cp))
 400     {
 401       char *dest = tokstr;
 402       token = T_ID;
 403       while (*cp == '_' || isalnum ((unsigned char) *cp))
 404         *dest++ = toupper ((unsigned char) (*cp++));
 405       *dest++ = '\0';
 406     }
 407   else
 408     token = *cp++;
 409
 410 #if DUMP_TOKENS
 411   dump_token ();
 412 #endif
 413
 414   return token;
 415 }
 416
 417 /* Force the current token to be an identifier token. */
 418 static void
 419 force_id (void)
 420 {
 421   if (token != T_ID)
 422     error ("Identifier expected.");
 423 }
 424
 425 /* Force the current token to be a string token. */
 426 static void
 427 force_string (void)
 428 {
 429   if (token != T_STRING)
 430     error ("String expected.");
 431 }
 432
 433 /* Checks whether the current token is the identifier S; if so, skips
 434    the token and returns true; otherwise, returns false. */
 435 static bool
 436 match_id (const char *s)
 437 {
 438   if (token == T_ID && !strcmp (tokstr, s))
 439     {
 440       lex_get ();
 441       return true;
 442     }
 443   return false;
 444 }
 445
 446 /* Checks whether the current token is T.  If so, skips the token and
 447    returns true; otherwise, returns false. */
 448 static bool
 449 match_token (int t)
 450 {
 451   if (token == t)
 452     {
 453       lex_get ();
 454       return true;
 455     }
 456   return false;
 457 }
 458
 459 /* Force the current token to be T, and skip it. */
 460 static void
 461 skip_token (int t)
 462 {
 463   if (token != t)
 464     error ("`%c' expected.", t);
 465   lex_get ();
 466 }
 467 \f
 468 /* Structures. */
 469
 470 /* Some specifiers have associated values. */
 471 enum
 472   {
 473     VAL_NONE,   /* No value. */
 474     VAL_INT,    /* Integer value. */
 475     VAL_DBL     /* Floating point value. */
 476   };
 477
 478 /* For those specifiers with values, the syntax of those values. */
 479 enum
 480   {
 481     VT_PLAIN,   /* Unadorned value. */
 482     VT_PAREN    /* Value must be enclosed in parentheses. */
 483   };
 484
 485 /* Forward definition. */
 486 typedef struct specifier specifier;
 487
 488 /* A single setting. */
 489 typedef struct setting setting;
 490 struct setting
 491   {
 492     specifier *parent;  /* Owning specifier. */
 493     setting *next;      /* Next in the chain. */
 494     char *specname;     /* Name of the setting. */
 495     int con;            /* Sequence number. */
 496
 497     /* Values. */
 498     int valtype;        /* One of VT_*. */
 499     int value;          /* One of VAL_*. */
 500     int optvalue;       /* 1=value is optional, 0=value is required. */
 501     char *valname;      /* Variable name for the value. */
 502     char *restriction;  /* !=NULL: expression specifying valid values. */
 503   };
 504
 505 /* A single specifier. */
 506 struct specifier
 507   {
 508     specifier *next;    /* Next in the chain. */
 509     char *varname;      /* Variable name. */
 510     setting *s;         /* Associated settings. */
 511
 512     setting *def;       /* Default setting. */
 513     setting *omit_kw;   /* Setting for which the keyword can be omitted. */
 514
 515     int index;          /* Next array index. */
 516   };
 517
 518 /* Subcommand types. */
 519 typedef enum
 520   {
 521     SBC_PLAIN,          /* The usual case. */
 522     SBC_VARLIST,        /* Variable list. */
 523     SBC_INT,            /* Integer value. */
 524     SBC_PINT,           /* Integer inside parentheses. */
 525     SBC_DBL,            /* Floating point value. */
 526     SBC_INT_LIST,       /* List of integers (?). */
 527     SBC_DBL_LIST,       /* List of floating points (?). */
 528     SBC_CUSTOM,         /* Custom. */
 529     SBC_ARRAY,          /* Array of boolean values. */
 530     SBC_STRING,         /* String value. */
 531     SBC_VAR             /* Single variable name. */
 532   }
 533 subcommand_type;
 534
 535 typedef enum
 536   {
 537     ARITY_ONCE_EXACTLY,  /* must occur exactly once */
 538     ARITY_ONCE_ONLY,     /* zero or once */
 539     ARITY_MANY           /* 0, 1, ... , inf */
 540   }subcommand_arity;
 541
 542 /* A single subcommand. */
 543 typedef struct subcommand subcommand;
 544 struct subcommand
 545   {
 546     subcommand *next;           /* Next in the chain. */
 547     char *name;                 /* Subcommand name. */
 548     subcommand_type type;       /* One of SBC_*. */
 549     subcommand_arity arity;     /* How many times should the subcommand occur*/
 550     int narray;                 /* Index of next array element. */
 551     const char *prefix;         /* Prefix for variable and constant names. */
 552     specifier *spec;            /* Array of specifiers. */
 553
 554     /* SBC_STRING and SBC_INT only. */
 555     char *restriction;          /* Expression restricting string length. */
 556     char *message;              /* Error message. */
 557     int translatable;           /* Error message is translatable */
 558   };
 559
 560 /* Name of the command; i.e., DESCRIPTIVES. */
 561 char *cmdname;
 562
 563 /* Short prefix for the command; i.e., `dsc_'. */
 564 char *prefix;
 565
 566 /* List of subcommands. */
 567 subcommand *subcommands;
 568
 569 /* Default subcommand if any, or NULL. */
 570 subcommand *def;
 571 \f
 572 /* Parsing. */
 573
 574 void parse_subcommands (void);
 575
 576 /* Parse an entire specification. */
 577 static void
 578 parse (void)
 579 {
 580   /* Get the command name and prefix. */
 581   if (token != T_STRING && token != T_ID)
 582     error ("Command name expected.");
 583   cmdname = xstrdup (tokstr);
 584   lex_get ();
 585   skip_token ('(');
 586   force_id ();
 587   prefix = xstrdup (tokstr);
 588   lex_get ();
 589   skip_token (')');
 590   skip_token (':');
 591
 592   /* Read all the subcommands. */
 593   subcommands = NULL;
 594   def = NULL;
 595   parse_subcommands ();
 596 }
 597
 598 /* Parses a single setting into S, given subcommand information SBC
 599    and specifier information SPEC. */
 600 static void
 601 parse_setting (setting *s, specifier *spec)
 602 {
 603   s->parent = spec;
 604
 605   if (match_token ('*'))
 606     {
 607       if (spec->omit_kw)
 608         error ("Cannot have two settings with omittable keywords.");
 609       else
 610         spec->omit_kw = s;
 611     }
 612
 613   if (match_token ('!'))
 614     {
 615       if (spec->def)
 616         error ("Cannot have two default settings.");
 617       else
 618         spec->def = s;
 619     }
 620
 621   force_id ();
 622   s->specname = xstrdup (tokstr);
 623   s->con = add_symbol (s->specname, 0, 0);
 624   s->value = VAL_NONE;
 625
 626   lex_get ();
 627
 628   /* Parse setting value info if necessary. */
 629   if (token != '/' && token != ';' && token != '.' && token != ',')
 630     {
 631       if (token == '(')
 632         {
 633           s->valtype = VT_PAREN;
 634           lex_get ();
 635         }
 636       else
 637         s->valtype = VT_PLAIN;
 638
 639       s->optvalue = match_token ('*');
 640
 641       if (match_id ("N"))
 642         s->value = VAL_INT;
 643       else if (match_id ("D"))
 644         s->value = VAL_DBL;
 645       else
 646         error ("`n' or `d' expected.");
 647
 648       skip_token (':');
 649
 650       force_id ();
 651       s->valname = xstrdup (tokstr);
 652       lex_get ();
 653
 654       if (token == ',')
 655         {
 656           lex_get ();
 657           force_string ();
 658           s->restriction = xstrdup (tokstr);
 659           lex_get ();
 660         }
 661       else
 662         s->restriction = NULL;
 663
 664       if (s->valtype == VT_PAREN)
 665         skip_token (')');
 666     }
 667 }
 668
 669 /* Parse a single specifier into SPEC, given subcommand information
 670    SBC. */
 671 static void
 672 parse_specifier (specifier *spec, subcommand *sbc)
 673 {
 674   spec->index = 0;
 675   spec->s = NULL;
 676   spec->def = NULL;
 677   spec->omit_kw = NULL;
 678   spec->varname = NULL;
 679
 680   if (token == T_ID)
 681     {
 682       spec->varname = xstrdup (st_lower (tokstr));
 683       lex_get ();
 684     }
 685
 686   /* Handle array elements. */
 687   if (token != ':')
 688     {
 689       spec->index = sbc->narray;
 690       if (sbc->type == SBC_ARRAY)
 691         {
 692           if (token == '|')
 693             token = ',';
 694           else
 695             sbc->narray++;
 696         }
 697       spec->s = NULL;
 698       return;
 699     }
 700   skip_token (':');
 701
 702   if ( sbc->type == SBC_ARRAY && token == T_ID )
 703     {
 704         spec->varname = xstrdup (st_lower (tokstr));
 705         spec->index = sbc->narray;
 706         sbc->narray++;
 707     }
 708
 709
 710
 711   /* Parse all the settings. */
 712   {
 713     setting **s = &spec->s;
 714
 715     for (;;)
 716       {
 717         *s = xmalloc (sizeof **s);
 718         parse_setting (*s, spec);
 719         if (token == ',' || token == ';' || token == '.')
 720           break;
 721         skip_token ('/');
 722         s = &(*s)->next;
 723       }
 724     (*s)->next = NULL;
 725   }
 726 }
 727
 728 /* Parse a list of specifiers for subcommand SBC. */
 729 static void
 730 parse_specifiers (subcommand *sbc)
 731 {
 732   specifier **spec = &sbc->spec;
 733
 734   if (token == ';' || token == '.')
 735     {
 736       *spec = NULL;
 737       return;
 738     }
 739
 740   for (;;)
 741     {
 742       *spec = xmalloc (sizeof **spec);
 743       parse_specifier (*spec, sbc);
 744       if (token == ';' || token == '.')
 745         break;
 746       skip_token (',');
 747       spec = &(*spec)->next;
 748     }
 749   (*spec)->next = NULL;
 750 }
 751
 752 /* Parse a subcommand into SBC. */
 753 static void
 754 parse_subcommand (subcommand *sbc)
 755 {
 756   if (match_token ('*'))
 757     {
 758       if (def)
 759         error ("Multiple default subcommands.");
 760       def = sbc;
 761     }
 762
 763   sbc->arity = ARITY_ONCE_ONLY;
 764   if ( match_token('+'))
 765     sbc->arity = ARITY_MANY;
 766   else if (match_token('^'))
 767     sbc->arity = ARITY_ONCE_EXACTLY ;
 768
 769
 770   force_id ();
 771   sbc->name = xstrdup (tokstr);
 772   lex_get ();
 773
 774   sbc->narray = 0;
 775   sbc->type = SBC_PLAIN;
 776   sbc->spec = NULL;
 777   sbc->translatable = 0;
 778
 779   if (match_token ('['))
 780     {
 781       force_id ();
 782       sbc->prefix = xstrdup (st_lower (tokstr));
 783       lex_get ();
 784
 785       skip_token (']');
 786       skip_token ('=');
 787
 788       sbc->type = SBC_ARRAY;
 789       parse_specifiers (sbc);
 790
 791     }
 792   else
 793     {
 794       if (match_token ('('))
 795         {
 796           force_id ();
 797           sbc->prefix = xstrdup (st_lower (tokstr));
 798           lex_get ();
 799
 800           skip_token (')');
 801         }
 802       else
 803         sbc->prefix = "";
 804
 805       skip_token ('=');
 806
 807       if (match_id ("VAR"))
 808         sbc->type = SBC_VAR;
 809       if (match_id ("VARLIST"))
 810         {
 811           if (match_token ('('))
 812             {
 813               force_string ();
 814               sbc->message = xstrdup (tokstr);
 815               lex_get();
 816
 817               skip_token (')');
 818             }
 819           else sbc->message = NULL;
 820
 821           sbc->type = SBC_VARLIST;
 822         }
 823       else if (match_id ("INTEGER"))
 824        {
 825         sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
 826         if ( token == T_STRING)
 827          {
 828               sbc->restriction = xstrdup (tokstr);
 829               lex_get ();
 830               if ( match_id("N_") )
 831                {
 832                 skip_token('(');
 833                 force_string ();
 834                 lex_get();
 835                 skip_token(')');
 836                 sbc->translatable = 1;
 837                }
 838               else {
 839                 force_string ();
 840                 lex_get ();
 841               }
 842               sbc->message = xstrdup (tokstr);
 843          }
 844         else
 845             sbc->restriction = NULL;
 846        }
 847       else if (match_id ("PINT"))
 848         sbc->type = SBC_PINT;
 849       else if (match_id ("DOUBLE"))
 850         {
 851           if ( match_id ("LIST") )
 852             sbc->type = SBC_DBL_LIST;
 853           else
 854             sbc->type = SBC_DBL;
 855         }
 856       else if (match_id ("STRING"))
 857         {
 858           sbc->type = SBC_STRING;
 859           if (token == T_STRING)
 860             {
 861               sbc->restriction = xstrdup (tokstr);
 862               lex_get ();
 863               force_string ();
 864               sbc->message = xstrdup (tokstr);
 865               lex_get ();
 866             }
 867           else
 868             sbc->restriction = NULL;
 869         }
 870       else if (match_id ("CUSTOM"))
 871         sbc->type = SBC_CUSTOM;
 872       else
 873         parse_specifiers (sbc);
 874     }
 875 }
 876
 877 /* Parse all the subcommands. */
 878 void
 879 parse_subcommands (void)
 880 {
 881   subcommand **sbc = &subcommands;
 882
 883   for (;;)
 884     {
 885       *sbc = xmalloc (sizeof **sbc);
 886       (*sbc)->next = NULL;
 887
 888       parse_subcommand (*sbc);
 889
 890       if (token == '.')
 891         return;
 892
 893       skip_token (';');
 894       sbc = &(*sbc)->next;
 895     }
 896 }
 897 \f
 898 /* Output. */
 899
 900 #define BASE_INDENT 2           /* Starting indent. */
 901 #define INC_INDENT 2            /* Indent increment. */
 902
 903 /* Increment the indent. */
 904 #define indent() indent += INC_INDENT
 905 #define outdent() indent -= INC_INDENT
 906
 907 /* Size of the indent from the left margin. */
 908 int indent;
 909
 910 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
 911
 912 /* Write line FORMAT to the output file, formatted as with printf,
 913    indented `indent' characters from the left margin.  If INDENTION is
 914    greater than 0, indents BASE_INDENT * INDENTION characters after
 915    writing the line; if INDENTION is less than 0, dedents BASE_INDENT
 916    * INDENTION characters _before_ writing the line. */
 917 void
 918 dump (int indention, const char *format, ...)
 919 {
 920   va_list args;
 921   int i;
 922
 923   if (indention < 0)
 924     indent += BASE_INDENT * indention;
 925
 926   oln++;
 927   va_start (args, format);
 928   for (i = 0; i < indent; i++)
 929     putc (' ', out);
 930   vfprintf (out, format, args);
 931   putc ('\n', out);
 932   va_end (args);
 933
 934   if (indention > 0)
 935     indent += BASE_INDENT * indention;
 936 }
 937
 938 /* Write the structure members for specifier SPEC to the output file.
 939    SBC is the including subcommand. */
 940 static void
 941 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
 942 {
 943   if (spec->varname)
 944     dump (0, "long %s%s;", sbc->prefix, spec->varname);
 945
 946   {
 947     setting *s;
 948
 949     for (s = spec->s; s; s = s->next)
 950       {
 951         if (s->value != VAL_NONE)
 952           {
 953             const char *typename;
 954
 955             assert (s->value == VAL_INT || s->value == VAL_DBL);
 956             typename = s->value == VAL_INT ? "long" : "double";
 957
 958             dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
 959           }
 960       }
 961   }
 962 }
 963
 964 /* Returns true if string T is a PSPP keyword, false otherwise. */
 965 static bool
 966 is_keyword (const char *t)
 967 {
 968   static const char *kw[] =
 969     {
 970       "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
 971       "NE", "ALL", "BY", "TO", "WITH", 0,
 972     };
 973   const char **cp;
 974
 975   for (cp = kw; *cp; cp++)
 976     if (!strcmp (t, *cp))
 977       return true;
 978   return false;
 979 }
 980
 981 /* Transforms a string NAME into a valid C identifier: makes
 982    everything lowercase and maps nonalphabetic characters to
 983    underscores.  Returns a pointer to a static buffer. */
 984 static char *
 985 make_identifier (const char *name)
 986 {
 987   char *p = get_buffer ();
 988   char *cp;
 989
 990   for (cp = p; *name; name++)
 991     if (isalpha ((unsigned char) *name))
 992       *cp++ = tolower ((unsigned char) (*name));
 993     else
 994       *cp++ = '_';
 995   *cp = '\0';
 996
 997   return p;
 998 }
 999
1000 /* Writes the struct and enum declarations for the parser. */
1001 static void
1002 dump_declarations (void)
1003 {
1004   indent = 0;
1005
1006   /* Write out enums for all the identifiers in the symbol table. */
1007   {
1008     int f, k;
1009     symbol *sym;
1010     char *buf = NULL;
1011
1012     /* Note the squirmings necessary to make sure that the last enum
1013        is not followed by a comma, as mandated by ANSI C89. */
1014     for (sym = symtab, f = k = 0; sym; sym = sym->next)
1015       if (!sym->unique && !is_keyword (sym->name))
1016         {
1017           if (!f)
1018             {
1019               dump (0, "/* Settings for subcommand specifiers. */");
1020               dump (1, "enum");
1021               dump (1, "{");
1022               f = 1;
1023             }
1024
1025           if (buf == NULL)
1026             buf = xmalloc (1024);
1027           else
1028             dump (0, buf);
1029
1030           if (k)
1031             sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1032           else
1033             {
1034               k = 1;
1035               sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1036             }
1037         }
1038     if (buf)
1039       {
1040         buf[strlen (buf) - 1] = 0;
1041         dump (0, buf);
1042         free (buf);
1043       }
1044     if (f)
1045       {
1046         dump (-1, "};");
1047         dump (-1, nullstr);
1048       }
1049   }
1050
1051   /* Write out some type definitions */
1052   {
1053     dump (0, "#define MAXLISTS 10");
1054   }
1055
1056
1057   /* For every array subcommand, write out the associated enumerated
1058      values. */
1059   {
1060     subcommand *sbc;
1061
1062     for (sbc = subcommands; sbc; sbc = sbc->next)
1063       if (sbc->type == SBC_ARRAY && sbc->narray)
1064         {
1065           dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1066
1067           dump (1, "enum");
1068           dump (1, "{");
1069
1070           {
1071             specifier *spec;
1072
1073             for (spec = sbc->spec; spec; spec = spec->next)
1074                 dump (0, "%s%s%s = %d,",
1075                       st_upper (prefix), st_upper (sbc->prefix),
1076                       st_upper (spec->varname), spec->index);
1077
1078             dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1079
1080             dump (-1, "};");
1081             dump (-1, nullstr);
1082           }
1083         }
1084   }
1085
1086   /* Write out structure declaration. */
1087   {
1088     subcommand *sbc;
1089
1090     dump (0, "/* %s structure. */", cmdname);
1091     dump (1, "struct cmd_%s", make_identifier (cmdname));
1092     dump (1, "{");
1093     for (sbc = subcommands; sbc; sbc = sbc->next)
1094       {
1095         int f = 0;
1096
1097         if (sbc != subcommands)
1098           dump (0, nullstr);
1099
1100         dump (0, "/* %s subcommand. */", sbc->name);
1101         dump (0, "int sbc_%s;", st_lower (sbc->name));
1102
1103         switch (sbc->type)
1104           {
1105           case SBC_ARRAY:
1106           case SBC_PLAIN:
1107             {
1108               specifier *spec;
1109
1110               for (spec = sbc->spec; spec; spec = spec->next)
1111                 {
1112                   if (spec->s == 0)
1113                     {
1114                       if (sbc->type == SBC_PLAIN)
1115                         dump (0, "long int %s%s;", st_lower (sbc->prefix),
1116                               spec->varname);
1117                       else if (f == 0)
1118                         {
1119                           dump (0, "int a_%s[%s%scount];",
1120                                 st_lower (sbc->name),
1121                                 st_upper (prefix),
1122                                 st_upper (sbc->prefix)
1123                                 );
1124
1125                           f = 1;
1126                         }
1127                     }
1128                   else
1129                     dump_specifier_vars (spec, sbc);
1130                 }
1131             }
1132             break;
1133
1134           case SBC_VARLIST:
1135             dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1136                   st_lower (sbc->name));
1137             dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
1138                   st_lower (sbc->name));
1139             break;
1140
1141           case SBC_VAR:
1142             dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
1143                   st_lower (sbc->name));
1144             break;
1145
1146           case SBC_STRING:
1147             dump (0, "char *s_%s;", st_lower (sbc->name));
1148             break;
1149
1150           case SBC_INT:
1151           case SBC_PINT:
1152             dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1153             break;
1154
1155           case SBC_DBL:
1156             dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1157             break;
1158
1159           case SBC_DBL_LIST:
1160             dump (0, "subc_list_double dl_%s[MAXLISTS];",
1161                   st_lower(sbc->name));
1162             break;
1163
1164           case SBC_INT_LIST:
1165             dump (0, "subc_list_int il_%s[MAXLISTS];",
1166                   st_lower(sbc->name));
1167             break;
1168
1169
1170           default:;
1171             /* nothing */
1172           }
1173       }
1174
1175     dump (-1, "};");
1176     dump (-1, nullstr);
1177   }
1178
1179   /* Write out prototypes for custom_*() functions as necessary. */
1180   {
1181     bool seen = false;
1182     subcommand *sbc;
1183
1184     for (sbc = subcommands; sbc; sbc = sbc->next)
1185       if (sbc->type == SBC_CUSTOM)
1186         {
1187           if (!seen)
1188             {
1189               seen = true;
1190               dump (0, "/* Prototype for custom subcommands of %s. */",
1191                     cmdname);
1192             }
1193           dump (0, "static int %scustom_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
1194                 st_lower (prefix), st_lower (sbc->name),
1195                 make_identifier (cmdname));
1196         }
1197
1198     if (seen)
1199       dump (0, nullstr);
1200   }
1201
1202   /* Prototypes for parsing and freeing functions. */
1203   {
1204     dump (0, "/* Command parsing functions. */");
1205     dump (0, "static int parse_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
1206           make_identifier (cmdname), make_identifier (cmdname));
1207     dump (0, "static void free_%s (struct cmd_%s *);",
1208           make_identifier (cmdname), make_identifier (cmdname));
1209     dump (0, nullstr);
1210   }
1211 }
1212
1213 /* Writes out code to initialize all the variables that need
1214    initialization for particular specifier SPEC inside subcommand SBC. */
1215 static void
1216 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1217 {
1218   if (spec->varname)
1219     {
1220       char s[256];
1221
1222       if (spec->def)
1223         sprintf (s, "%s%s",
1224                  st_upper (prefix), find_symbol (spec->def->con)->name);
1225       else
1226         strcpy (s, "-1");
1227       dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1228     }
1229
1230   {
1231     setting *s;
1232
1233     for (s = spec->s; s; s = s->next)
1234       {
1235         if (s->value != VAL_NONE)
1236           {
1237             const char *init;
1238
1239             assert (s->value == VAL_INT || s->value == VAL_DBL);
1240             init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
1241
1242             dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1243           }
1244       }
1245   }
1246 }
1247
1248 /* Write code to initialize all variables. */
1249 static void
1250 dump_vars_init (int persistent)
1251 {
1252   /* Loop through all the subcommands. */
1253   {
1254     subcommand *sbc;
1255
1256     for (sbc = subcommands; sbc; sbc = sbc->next)
1257       {
1258         int f = 0;
1259
1260         dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1261         if ( ! persistent )
1262           {
1263             switch (sbc->type)
1264               {
1265               case SBC_INT_LIST:
1266                 break;
1267
1268               case SBC_DBL_LIST:
1269                 dump (1, "{");
1270                 dump (0, "int i;");
1271                 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1272                 dump (0, "subc_list_double_create(&p->dl_%s[i]) ;",
1273                       st_lower (sbc->name)
1274                       );
1275                 dump (-2, "}");
1276                 break;
1277
1278               case SBC_DBL:
1279                 dump (1, "{");
1280                 dump (0, "int i;");
1281                 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1282                 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1283                 dump (-2, "}");
1284                 break;
1285
1286               case SBC_CUSTOM:
1287                 /* nothing */
1288                 break;
1289
1290               case SBC_PLAIN:
1291               case SBC_ARRAY:
1292                 {
1293                   specifier *spec;
1294
1295                   for (spec = sbc->spec; spec; spec = spec->next)
1296                     if (spec->s == NULL)
1297                       {
1298                         if (sbc->type == SBC_PLAIN)
1299                           dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1300                         else if (f == 0)
1301                           {
1302                             dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1303                                   st_lower (sbc->name), st_lower (sbc->name));
1304                             f = 1;
1305                           }
1306                       }
1307                     else
1308                       dump_specifier_init (spec, sbc);
1309                 }
1310                 break;
1311
1312               case SBC_VARLIST:
1313                 dump (0, "p->%sn_%s = 0;",
1314                       st_lower (sbc->prefix), st_lower (sbc->name));
1315                 dump (0, "p->%sv_%s = NULL;",
1316                       st_lower (sbc->prefix), st_lower (sbc->name));
1317                 break;
1318
1319               case SBC_VAR:
1320                 dump (0, "p->%sv_%s = NULL;",
1321                       st_lower (sbc->prefix), st_lower (sbc->name));
1322                 break;
1323
1324               case SBC_STRING:
1325                 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1326                 break;
1327
1328               case SBC_INT:
1329               case SBC_PINT:
1330                 dump (1, "{");
1331                 dump (0, "int i;");
1332                 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1333                 dump (0, "p->n_%s[i] = NOT_LONG;", st_lower (sbc->name));
1334                 dump (-2, "}");
1335                 break;
1336
1337               default:
1338                 abort ();
1339               }
1340           }
1341       }
1342   }
1343 }
1344
1345 /* Return a pointer to a static buffer containing an expression that
1346    will match token T. */
1347 static char *
1348 make_match (const char *t)
1349 {
1350   char *s;
1351
1352   s = get_buffer ();
1353
1354   while (*t == '_')
1355     t++;
1356
1357   if (is_keyword (t))
1358     sprintf (s, "lex_match (lexer, T_%s)", t);
1359   else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1360     strcpy (s, "(lex_match_id (lexer, \"ON\") || lex_match_id (lexer, \"YES\") "
1361             "|| lex_match_id (lexer, \"TRUE\"))");
1362   else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1363     strcpy (s, "(lex_match_id (lexer, \"OFF\") || lex_match_id (lexer, \"NO\") "
1364             "|| lex_match_id (lexer, \"FALSE\"))");
1365   else if (isdigit ((unsigned char) t[0]))
1366     sprintf (s, "lex_match_int (lexer, %s)", t);
1367   else
1368     sprintf (s, "lex_match_id (lexer, \"%s\")", t);
1369
1370   return s;
1371 }
1372
1373 /* Write out the parsing code for specifier SPEC within subcommand
1374    SBC. */
1375 static void
1376 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1377 {
1378   setting *s;
1379
1380   if (spec->omit_kw && spec->omit_kw->next)
1381     error ("Omittable setting is not last setting in `%s' specifier.",
1382            spec->varname);
1383   if (spec->omit_kw && spec->omit_kw->parent->next)
1384     error ("Default specifier is not in last specifier in `%s' "
1385            "subcommand.", sbc->name);
1386
1387   for (s = spec->s; s; s = s->next)
1388     {
1389       int first = spec == sbc->spec && s == spec->s;
1390
1391       /* Match the setting's keyword. */
1392       if (spec->omit_kw == s)
1393         {
1394           if (!first)
1395             {
1396               dump (1, "else");
1397               dump (1, "{");
1398             }
1399           dump (1, "%s;", make_match (s->specname));
1400         }
1401       else
1402         dump (1, "%sif (%s)", first ? "" : "else ",
1403               make_match (s->specname));
1404
1405
1406       /* Handle values. */
1407       if (s->value == VAL_NONE)
1408         dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1409               st_upper (prefix), find_symbol (s->con)->name);
1410       else
1411         {
1412           if (spec->omit_kw != s)
1413             dump (1, "{");
1414
1415           if (spec->varname)
1416             {
1417               dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1418                     st_upper (prefix), find_symbol (s->con)->name);
1419
1420               if ( sbc->type == SBC_ARRAY )
1421                 dump (0, "p->a_%s[%s%s%s] = 1;",
1422                       st_lower (sbc->name),
1423                       st_upper (prefix), st_upper (sbc->prefix),
1424                       st_upper (spec->varname));
1425             }
1426
1427
1428           if (s->valtype == VT_PAREN)
1429             {
1430               if (s->optvalue)
1431                 {
1432                   dump (1, "if (lex_match (lexer, '('))");
1433                   dump (1, "{");
1434                 }
1435               else
1436                 {
1437                   dump (1, "if (!lex_match (lexer, '('))");
1438                   dump (1, "{");
1439                   dump (0, "msg (SE, _(\"`(' expected after %s "
1440                         "specifier of %s subcommand.\"));",
1441                         s->specname, sbc->name);
1442                   dump (0, "goto lossage;");
1443                   dump (-1, "}");
1444                   outdent ();
1445                 }
1446             }
1447
1448           if (s->value == VAL_INT)
1449             {
1450               dump (1, "if (!lex_is_integer (lexer))");
1451               dump (1, "{");
1452               dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1453                     "requires an integer argument.\"));",
1454                     s->specname, sbc->name);
1455               dump (0, "goto lossage;");
1456               dump (-1, "}");
1457               dump (-1, "p->%s%s = lex_integer (lexer);",
1458                     sbc->prefix, st_lower (s->valname));
1459             }
1460           else
1461             {
1462               dump (1, "if (!lex_is_number (lexer))");
1463               dump (1, "{");
1464               dump (0, "msg (SE, _(\"Number expected after %s "
1465                     "specifier of %s subcommand.\"));",
1466                     s->specname, sbc->name);
1467               dump (0, "goto lossage;");
1468               dump (-1, "}");
1469               dump (-1, "p->%s%s = lex_tokval (lexer);", sbc->prefix,
1470                     st_lower (s->valname));
1471             }
1472
1473           if (s->restriction)
1474             {
1475               {
1476                 char *str, *str2;
1477                 str = xmalloc (MAX_TOK_LEN);
1478                 str2 = xmalloc (MAX_TOK_LEN);
1479                 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1480                 sprintf (str, s->restriction, str2, str2, str2, str2,
1481                          str2, str2, str2, str2);
1482                 dump (1, "if (!(%s))", str);
1483                 free (str);
1484                 free (str2);
1485               }
1486
1487               dump (1, "{");
1488               dump (0, "msg (SE, _(\"Bad argument for %s "
1489                     "specifier of %s subcommand.\"));",
1490                     s->specname, sbc->name);
1491               dump (0, "goto lossage;");
1492               dump (-1, "}");
1493               outdent ();
1494             }
1495
1496           dump (0, "lex_get (lexer);");
1497
1498           if (s->valtype == VT_PAREN)
1499             {
1500               dump (1, "if (!lex_match (lexer, ')'))");
1501               dump (1, "{");
1502               dump (0, "msg (SE, _(\"`)' expected after argument for "
1503                     "%s specifier of %s.\"));",
1504                     s->specname, sbc->name);
1505               dump (0, "goto lossage;");
1506               dump (-1, "}");
1507               outdent ();
1508               if (s->optvalue)
1509                 {
1510                   dump (-1, "}");
1511                   outdent ();
1512                 }
1513             }
1514
1515           if (s != spec->omit_kw)
1516             dump (-1, "}");
1517         }
1518
1519       if (s == spec->omit_kw)
1520         {
1521           dump (-1, "}");
1522           outdent ();
1523         }
1524       outdent ();
1525     }
1526 }
1527
1528 /* Write out the code to parse subcommand SBC. */
1529 static void
1530 dump_subcommand (const subcommand *sbc)
1531 {
1532   if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1533     {
1534       int count;
1535
1536       dump (1, "while (lex_token (lexer) != '/' && lex_token (lexer) != '.')");
1537       dump (1, "{");
1538
1539       {
1540         specifier *spec;
1541
1542         for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1543           {
1544             if (spec->s)
1545               dump_specifier_parse (spec, sbc);
1546             else
1547               {
1548                 count++;
1549                 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1550                       make_match (st_upper (spec->varname)));
1551                 if (sbc->type == SBC_PLAIN)
1552                   dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1553                         spec->varname);
1554                 else
1555                   dump (0, "p->a_%s[%s%s%s] = 1;",
1556                         st_lower (sbc->name),
1557                         st_upper (prefix), st_upper (sbc->prefix),
1558                         st_upper (spec->varname));
1559                 outdent ();
1560               }
1561           }
1562       }
1563
1564       {
1565         specifier *spec;
1566         setting *s;
1567
1568         /* This code first finds the last specifier in sbc.  Then it
1569            finds the last setting within that last specifier.  Either
1570            or both might be NULL. */
1571         spec = sbc->spec;
1572         s = NULL;
1573         if (spec)
1574           {
1575             while (spec->next)
1576               spec = spec->next;
1577             s = spec->s;
1578             if (s)
1579               while (s->next)
1580                 s = s->next;
1581           }
1582
1583         if (spec && (!spec->s || !spec->omit_kw))
1584           {
1585             dump (1, "else");
1586             dump (1, "{");
1587             dump (0, "lex_error (lexer, NULL);");
1588             dump (0, "goto lossage;");
1589             dump (-1, "}");
1590             outdent ();
1591           }
1592       }
1593
1594       dump (0, "lex_match (lexer, ',');");
1595       dump (-1, "}");
1596       outdent ();
1597     }
1598   else if (sbc->type == SBC_VARLIST)
1599     {
1600       dump (1, "if (!parse_variables (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1601             "PV_APPEND%s%s))",
1602             st_lower (sbc->prefix), st_lower (sbc->name),
1603             st_lower (sbc->prefix), st_lower (sbc->name),
1604             sbc->message ? " |" : "",
1605             sbc->message ? sbc->message : "");
1606       dump (0, "goto lossage;");
1607       outdent ();
1608     }
1609   else if (sbc->type == SBC_VAR)
1610     {
1611       dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
1612             st_lower (sbc->prefix), st_lower (sbc->name));
1613       dump (1, "if (!p->%sv_%s)",
1614             st_lower (sbc->prefix), st_lower (sbc->name));
1615       dump (0, "goto lossage;");
1616       outdent ();
1617     }
1618   else if (sbc->type == SBC_STRING)
1619     {
1620       if (sbc->restriction)
1621         {
1622           dump (1, "{");
1623           dump (0, "int x;");
1624         }
1625       dump (1, "if (!lex_force_string (lexer))");
1626       dump (0, "return false;");
1627       outdent ();
1628       if (sbc->restriction)
1629         {
1630           dump (0, "x = ds_length (lex_tokstr (lexer));");
1631           dump (1, "if (!(%s))", sbc->restriction);
1632           dump (1, "{");
1633           dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1634                 sbc->name, sbc->message);
1635           dump (0, "goto lossage;");
1636           dump (-1, "}");
1637           outdent ();
1638         }
1639       dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1640       dump (0, "p->s_%s = ds_xstrdup (lex_tokstr (lexer));",
1641             st_lower (sbc->name));
1642       dump (0, "lex_get (lexer);");
1643       if (sbc->restriction)
1644         dump (-1, "}");
1645     }
1646   else if (sbc->type == SBC_DBL)
1647     {
1648       dump (1, "if (!lex_force_num (lexer))");
1649       dump (0, "goto lossage;");
1650       dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
1651             st_lower (sbc->name), st_lower (sbc->name) );
1652       dump (0, "lex_get(lexer);");
1653     }
1654   else if (sbc->type == SBC_INT)
1655     {
1656       dump(1, "{");
1657       dump(0, "int x;");
1658       dump (1, "if (!lex_force_int (lexer))");
1659       dump (0, "goto lossage;");
1660       dump (-1, "x = lex_integer (lexer);");
1661       dump (0, "lex_get(lexer);");
1662       if (sbc->restriction)
1663        {
1664           char buf[1024];
1665           dump (1, "if (!(%s))", sbc->restriction);
1666           dump (1, "{");
1667           sprintf(buf,sbc->message,sbc->name);
1668           if ( sbc->translatable )
1669                   dump (0, "msg (SE, gettext(\"%s\"));",buf);
1670           else
1671                   dump (0, "msg (SE, \"%s\");",buf);
1672           dump (0, "goto lossage;");
1673           dump (-1, "}");
1674       }
1675       dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1676       dump (-1,"}");
1677     }
1678   else if (sbc->type == SBC_PINT)
1679     {
1680       dump (0, "lex_match (lexer, '(');");
1681       dump (1, "if (!lex_force_int (lexer))");
1682       dump (0, "goto lossage;");
1683       dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
1684       dump (0, "lex_match (lexer, ')');");
1685     }
1686   else if (sbc->type == SBC_DBL_LIST)
1687     {
1688       dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1689       dump (1, "{");
1690       dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1691       dump (0, "goto lossage;");
1692       dump (-1,"}");
1693
1694       dump (1, "while (lex_token (lexer) != '/' && lex_token (lexer) != '.')");
1695       dump (1, "{");
1696       dump (0, "lex_match (lexer, ',');");
1697       dump (0, "if (!lex_force_num (lexer))");
1698       dump (1, "{");
1699       dump (0, "goto lossage;");
1700       dump (-1,"}");
1701
1702       dump (0, "subc_list_double_push (&p->dl_%s[p->sbc_%s-1], lex_number (lexer));",
1703             st_lower (sbc->name), st_lower (sbc->name)
1704             );
1705
1706       dump (0, "lex_get (lexer);");
1707       dump (-1,"}");
1708
1709     }
1710   else if (sbc->type == SBC_CUSTOM)
1711     {
1712       dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1713             st_lower (prefix), st_lower (sbc->name));
1714       dump (0, "{");
1715       dump (1, "case 0:");
1716       dump (0, "goto lossage;");
1717       dump (-1, "case 1:");
1718       indent ();
1719       dump (0, "break;");
1720       dump (-1, "case 2:");
1721       indent ();
1722       dump (0, "lex_error (lexer, NULL);");
1723       dump (0, "goto lossage;");
1724       dump (-1, "default:");
1725       indent ();
1726       dump (0, "NOT_REACHED ();");
1727       dump (-1, "}");
1728       outdent ();
1729     }
1730 }
1731
1732 /* Write out entire parser. */
1733 static void
1734 dump_parser (int persistent)
1735 {
1736   int f;
1737
1738   indent = 0;
1739
1740   dump (0, "static int");
1741   dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
1742         make_identifier (cmdname),
1743         (def && ( def->type == SBC_VARLIST && def->type == SBC_CUSTOM))?"":" UNUSED",
1744         make_identifier (cmdname));
1745   dump (1, "{");
1746
1747   dump_vars_init (persistent);
1748
1749   dump (1, "for (;;)");
1750   dump (1, "{");
1751
1752   f = 0;
1753   if (def && (def->type == SBC_VARLIST))
1754     {
1755       if (def->type == SBC_VARLIST)
1756         dump (1, "if (lex_token (lexer) == T_ID "
1757               "&& dict_lookup_var (dataset_dict (ds), lex_tokid (lexer)) != NULL "
1758               "&& lex_look_ahead (lexer) != '=')");
1759       else
1760         {
1761           dump (0, "if ((lex_token (lexer) == T_ID "
1762                 "&& dict_lookup_var (dataset_dict (ds), lex_tokid (lexer)) "
1763                 "&& lex_look_ahead () != '=')");
1764           dump (1, "     || token == T_ALL)");
1765         }
1766       dump (1, "{");
1767       dump (0, "p->sbc_%s++;", st_lower (def->name));
1768       dump (1, "if (!parse_variables (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1769             "PV_APPEND))",
1770             st_lower (def->prefix), st_lower (def->name),
1771             st_lower (def->prefix), st_lower (def->name));
1772       dump (0, "goto lossage;");
1773       dump (-2, "}");
1774       outdent ();
1775       f = 1;
1776     }
1777   else if (def && def->type == SBC_CUSTOM)
1778     {
1779       dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1780             st_lower (prefix), st_lower (def->name));
1781       dump (0, "{");
1782       dump (1, "case 0:");
1783       dump (0, "goto lossage;");
1784       dump (-1, "case 1:");
1785       indent ();
1786       dump (0, "p->sbc_%s++;", st_lower (def->name));
1787       dump (0, "continue;");
1788       dump (-1, "case 2:");
1789       indent ();
1790       dump (0, "break;");
1791       dump (-1, "default:");
1792       indent ();
1793       dump (0, "NOT_REACHED ();");
1794       dump (-1, "}");
1795       outdent ();
1796     }
1797
1798   {
1799     subcommand *sbc;
1800
1801     for (sbc = subcommands; sbc; sbc = sbc->next)
1802       {
1803         dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1804         f = 1;
1805         dump (1, "{");
1806
1807         dump (0, "lex_match (lexer, '=');");
1808         dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1809         if (sbc->arity != ARITY_MANY)
1810           {
1811             dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1812             dump (1, "{");
1813             dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1814                   sbc->name);
1815             dump (0, "goto lossage;");
1816             dump (-1, "}");
1817             outdent ();
1818           }
1819         dump_subcommand (sbc);
1820         dump (-1, "}");
1821         outdent ();
1822       }
1823   }
1824
1825
1826   /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1827   dump(1,"else if ( get_syntax() != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
1828   dump(1,"{");
1829
1830   dump (0, "lex_match (lexer, '=');");
1831
1832   dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
1833   dump(0,"set_cmd_algorithm(COMPATIBLE);");
1834   outdent();
1835   dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
1836   dump(0,"set_cmd_algorithm(ENHANCED);");
1837
1838   dump (-1, "}");
1839   outdent ();
1840
1841
1842
1843   dump (1, "if (!lex_match (lexer, '/'))");
1844   dump (0, "break;");
1845   dump (-2, "}");
1846   outdent ();
1847   dump (0, nullstr);
1848   dump (1, "if (lex_token (lexer) != '.')");
1849   dump (1, "{");
1850   dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
1851   dump (0, "goto lossage;");
1852   dump (-1, "}");
1853   dump (0, nullstr);
1854
1855   outdent ();
1856
1857   {
1858     /*  Check that mandatory subcommands have been specified  */
1859     subcommand *sbc;
1860
1861     for (sbc = subcommands; sbc; sbc = sbc->next)
1862       {
1863
1864         if ( sbc->arity == ARITY_ONCE_EXACTLY )
1865           {
1866             dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1867             dump (1, "{");
1868             dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
1869                   sbc->name);
1870             dump (0, "goto lossage;");
1871             dump (-1, "}");
1872             dump (0, nullstr);
1873           }
1874       }
1875   }
1876
1877   dump (-1, "return true;");
1878   dump (0, nullstr);
1879   dump (-1, "lossage:");
1880   indent ();
1881   dump (0, "free_%s (p);", make_identifier (cmdname));
1882   dump (0, "return false;");
1883   dump (-1, "}");
1884   dump (0, nullstr);
1885 }
1886
1887
1888 /* Write the output file header. */
1889 static void
1890 dump_header (void)
1891 {
1892   indent = 0;
1893   dump (0,   "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1894   dump (0, nullstr);
1895   dump (0, "   Generated by q2c from %s.", ifn);
1896   dump (0, "   Do not modify!");
1897   dump (0, " */");
1898 }
1899
1900 /* Write out commands to free variable state. */
1901 static void
1902 dump_free (int persistent)
1903 {
1904   subcommand *sbc;
1905   int used;
1906
1907   indent = 0;
1908
1909   used = 0;
1910   if ( ! persistent )
1911     {
1912       for (sbc = subcommands; sbc; sbc = sbc->next)
1913         {
1914         if (sbc->type == SBC_STRING)
1915           used = 1;
1916         if (sbc->type == SBC_DBL_LIST)
1917           used = 1;
1918         }
1919
1920     }
1921
1922   dump (0, "static void");
1923   dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1924         make_identifier (cmdname), used ? "" : " UNUSED");
1925   dump (1, "{");
1926
1927   if ( ! persistent )
1928     {
1929
1930       for (sbc = subcommands; sbc; sbc = sbc->next)
1931         {
1932           switch (sbc->type)
1933             {
1934             case SBC_VARLIST:
1935               dump (0, "free (p->v_%s);", st_lower (sbc->name));
1936               break;
1937             case SBC_STRING:
1938               dump (0, "free (p->s_%s);", st_lower (sbc->name));
1939               break;
1940             case SBC_DBL_LIST:
1941               dump (0, "{");
1942               dump (1, "int i;");
1943               dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
1944               dump (1, "subc_list_double_destroy(&p->dl_%s[i]);", st_lower (sbc->name));
1945               dump (0, "}");
1946               outdent();
1947               break;
1948             default:
1949               break;
1950             }
1951         }
1952     }
1953
1954   dump (-1, "}");
1955
1956 }
1957
1958
1959
1960 /* Returns the name of a directive found on the current input line, if
1961    any, or a null pointer if none found. */
1962 static const char *
1963 recognize_directive (void)
1964 {
1965   static char directive[16];
1966   char *sp, *ep;
1967
1968   sp = skip_ws (buf);
1969   if (strncmp (sp, "/*", 2))
1970     return NULL;
1971   sp = skip_ws (sp + 2);
1972   if (*sp != '(')
1973     return NULL;
1974   sp++;
1975
1976   ep = strchr (sp, ')');
1977   if (ep == NULL)
1978     return NULL;
1979
1980   if (ep - sp > 15)
1981     ep = sp + 15;
1982   memcpy (directive, sp, ep - sp);
1983   directive[ep - sp] = '\0';
1984   return directive;
1985 }
1986
1987 int
1988 main (int argc, char *argv[])
1989 {
1990   program_name = argv[0];
1991   if (argc != 3)
1992     fail ("Syntax: q2c input.q output.c");
1993
1994   ifn = argv[1];
1995   in = fopen (ifn, "r");
1996   if (!in)
1997     fail ("%s: open: %s.", ifn, strerror (errno));
1998
1999   ofn = argv[2];
2000   out = fopen (ofn, "w");
2001   if (!out)
2002     fail ("%s: open: %s.", ofn, strerror (errno));
2003
2004   is_open = true;
2005   buf = xmalloc (MAX_LINE_LEN);
2006   tokstr = xmalloc (MAX_TOK_LEN);
2007
2008   dump_header ();
2009
2010
2011   indent = 0;
2012   dump (0, "#line %d \"%s\"", ln + 1, ifn);
2013   while (get_line ())
2014     {
2015       const char *directive = recognize_directive ();
2016       if (directive == NULL)
2017         {
2018           dump (0, "%s", buf);
2019           continue;
2020         }
2021
2022       dump (0, "#line %d \"%s\"", oln + 1, ofn);
2023       if (!strcmp (directive, "specification"))
2024         {
2025           /* Skip leading slash-star line. */
2026           get_line ();
2027           lex_get ();
2028
2029           parse ();
2030
2031           /* Skip trailing star-slash line. */
2032           get_line ();
2033         }
2034       else if (!strcmp (directive, "headers"))
2035         {
2036           indent = 0;
2037
2038           dump (0, "#include <stdlib.h>");
2039           dump (0, "#include <libpspp/alloc.h>");
2040           dump (0, "#include <libpspp/assertion.h>");
2041           dump (0, "#include <libpspp/message.h>");
2042           dump (0, "#include <language/lexer/lexer.h>");
2043           dump (0, "#include <language/lexer/variable-parser.h>");
2044           dump (0, "#include <data/settings.h>");
2045           dump (0, "#include <libpspp/str.h>");
2046           dump (0, "#include <language/lexer/subcommand-list.h>");
2047           dump (0, "#include <data/variable.h>");
2048           dump (0, nullstr);
2049
2050           dump (0, "#include \"gettext.h\"");
2051           dump (0, "#define _(msgid) gettext (msgid)");
2052           dump (0, nullstr);
2053         }
2054       else if (!strcmp (directive, "declarations"))
2055         dump_declarations ();
2056       else if (!strcmp (directive, "functions"))
2057         {
2058           dump_parser (0);
2059           dump_free (0);
2060         }
2061       else if (!strcmp (directive, "_functions"))
2062         {
2063           dump_parser (1);
2064           dump_free (1);
2065         }
2066       else
2067         error ("unknown directive `%s'", directive);
2068       indent = 0;
2069       dump (0, "#line %d \"%s\"", ln + 1, ifn);
2070     }
2071
2072   return EXIT_SUCCESS;
2073 }