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