src/q2c.c

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