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 #if __GNUC__ >= 2
 103 void hcf (void) __attribute__ ((noreturn));
 104 #endif
 105
 106 /* Terminate unsuccessfully. */
 107 void
 108 hcf (void)
 109 {
 110   finish_up ();
 111   exit (EXIT_FAILURE);
 112 }
 113
 114 #if __GNUC__ >= 2
 115 int fail (const char *, ...) __attribute__ ((format (printf, 1, 2)));
 116 int error (const char *, ...) __attribute__ ((format (printf, 1, 2)));
 117 #endif
 118
 119 /* Output an error message and terminate unsuccessfully. */
 120 int
 121 fail (const char *format, ...)
 122 {
 123   va_list args;
 124
 125   va_start (args, format);
 126   fprintf (stderr, "%s: ", pgmname);
 127   vfprintf (stderr, format, args);
 128   fprintf (stderr, "\n");
 129   va_end (args);
 130
 131   hcf ();
 132 }
 133
 134 /* Output a context-dependent error message and terminate
 135    unsuccessfully. */
 136 int
 137 error (const char *format,...)
 138 {
 139   va_list args;
 140
 141   va_start (args, format);
 142   fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
 143   vfprintf (stderr, format, args);
 144   fprintf (stderr, "\n");
 145   va_end (args);
 146
 147   hcf ();
 148 }
 149
 150 #define VME "virtual memory exhausted"
 151
 152 /* Allocate a block of SIZE bytes and return a pointer to its
 153    beginning. */
 154 static void *
 155 xmalloc (size_t size)
 156 {
 157   void *vp;
 158
 159   if (size == 0)
 160     return NULL;
 161
 162   vp = malloc (size);
 163   if (!vp)
 164     fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
 165
 166   return vp;
 167 }
 168
 169 /* Make a dynamically allocated copy of string S and return a pointer
 170    to the first character. */
 171 static char *
 172 xstrdup (const char *s)
 173 {
 174   size_t size;
 175   char *t;
 176
 177   assert (s != NULL);
 178   size = strlen (s) + 1;
 179
 180   t = malloc (size);
 181   if (!t)
 182     fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
 183
 184   memcpy (t, s, size);
 185   return t;
 186 }
 187
 188 /* Returns a pointer to one of 8 static buffers.  The buffers are used
 189    in rotation. */
 190 static char *
 191 get_buffer (void)
 192 {
 193   static char b[8][256];
 194   static int cb;
 195
 196   if (++cb >= 8)
 197     cb = 0;
 198
 199   return b[cb];
 200 }
 201
 202 /* Copies a string to a static buffer, converting it to lowercase in
 203    the process, and returns a pointer to the static buffer. */
 204 static char *
 205 st_lower (const char *s)
 206 {
 207   char *p, *cp;
 208
 209   p = cp = get_buffer ();
 210   while (*s)
 211     *cp++ = tolower ((unsigned char) (*s++));
 212   *cp++ = '\0';
 213
 214   return p;
 215 }
 216
 217 /* Copies a string to a static buffer, converting it to uppercase in
 218    the process, and returns a pointer to the static buffer. */
 219 static char *
 220 st_upper (const char *s)
 221 {
 222   char *p, *cp;
 223
 224   p = cp = get_buffer ();
 225   while (*s)
 226     *cp++ = toupper ((unsigned char) (*s++));
 227   *cp++ = '\0';
 228
 229   return p;
 230 }
 231
 232 /* Returns the address of the first non-whitespace character in S, or
 233    the address of the null terminator if none. */
 234 static char *
 235 skip_ws (const char *s)
 236 {
 237   while (isspace ((unsigned char) *s))
 238     s++;
 239   return (char *) s;
 240 }
 241
 242 /* Read one line from the input file into buf.  Lines having special
 243    formats are handled specially. */
 244 static int
 245 get_line (void)
 246 {
 247   ln++;
 248   if (0 == fgets (buf, MAX_LINE_LEN, in))
 249     {
 250       if (ferror (in))
 251         fail ("%s: fgets: %s", ifn, strerror (errno));
 252       return 0;
 253     }
 254
 255   cp = strchr (buf, '\n');
 256   if (cp != NULL)
 257     *cp = '\0';
 258
 259   cp = buf;
 260   return 1;
 261 }
 262 \f
 263 /* Symbol table manager. */
 264
 265 /* Symbol table entry. */
 266 typedef struct symbol symbol;
 267 struct symbol
 268   {
 269     symbol *next;               /* Next symbol in symbol table. */
 270     char *name;                 /* Symbol name. */
 271     int unique;                 /* 1=Name must be unique in this file. */
 272     int ln;                     /* Line number of definition. */
 273     int value;                  /* Symbol value. */
 274   };
 275
 276 /* Symbol table. */
 277 symbol *symtab;
 278
 279 /* Add a symbol to the symbol table having name NAME, uniqueness
 280    UNIQUE, and value VALUE.  If a symbol having the same name is found
 281    in the symbol table, its sequence number is returned and the symbol
 282    table is not modified.  Otherwise, the symbol is added and the next
 283    available sequence number is returned. */
 284 static int
 285 add_symbol (const char *name, int unique, int value)
 286 {
 287   symbol *iter, *sym;
 288   int x;
 289
 290   sym = xmalloc (sizeof (symbol));
 291   sym->name = xstrdup (name);
 292   sym->unique = unique;
 293   sym->value = value;
 294   sym->next = NULL;
 295   sym->ln = ln;
 296   if (!symtab)
 297     {
 298       symtab = sym;
 299       return 1;
 300     }
 301   iter = symtab;
 302   x = 1;
 303   for (;;)
 304     {
 305       if (!strcmp (iter->name, name))
 306         {
 307           if (iter->unique)
 308             {
 309               fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
 310                        ln, name);
 311               fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
 312                        iter->ln);
 313               hcf ();
 314             }
 315           free (sym->name);
 316           free (sym);
 317           return x;
 318         }
 319       if (!iter->next)
 320         break;
 321       iter = iter->next;
 322       x++;
 323     }
 324   iter->next = sym;
 325   return ++x;
 326 }
 327
 328 /* Finds the symbol having given sequence number X within the symbol
 329    table, and returns the associated symbol structure. */
 330 static symbol *
 331 find_symbol (int x)
 332 {
 333   symbol *iter;
 334
 335   iter = symtab;
 336   while (x > 1 && iter)
 337     {
 338       iter = iter->next;
 339       x--;
 340     }
 341   assert (iter);
 342   return iter;
 343 }
 344
 345 #if DEBUGGING
 346 /* Writes a printable representation of the current token to
 347    stdout. */
 348 void
 349 dump_token (void)
 350 {
 351   switch (token)
 352     {
 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 == '_' || isalnum ((unsigned char) *cp))
 381     {
 382       char *dest = tokstr;
 383       token = T_ID;
 384       while (*cp == '_' || isalnum ((unsigned char) *cp))
 385         *dest++ = toupper ((unsigned char) (*cp++));
 386       *dest++ = '\0';
 387     }
 388   else if (*cp == '"')
 389     {
 390       char *dest = tokstr;
 391       token = T_STRING;
 392       cp++;
 393       while (*cp != '"' && *cp)
 394         {
 395           if (*cp == '\\')
 396             {
 397               cp++;
 398               if (!*cp)
 399                 error ("Unterminated string literal.");
 400               *dest++ = *cp++;
 401             }
 402           else
 403             *dest++ = *cp++;
 404         }
 405       *dest++ = 0;
 406       if (!*cp)
 407         error ("Unterminated string literal.");
 408       cp++;
 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 only. */
 551     char *restriction;          /* Expression restricting string length. */
 552     char *message;              /* Error message. */
 553   };
 554
 555 /* Name of the command; i.e., DESCRIPTIVES. */
 556 char *cmdname;
 557
 558 /* Short prefix for the command; i.e., `dsc_'. */
 559 char *prefix;
 560
 561 /* List of subcommands. */
 562 subcommand *subcommands;
 563
 564 /* Default subcommand if any, or NULL. */
 565 subcommand *def;
 566 \f
 567 /* Parsing. */
 568
 569 void parse_subcommands (void);
 570
 571 /* Parse an entire specification. */
 572 static void
 573 parse (void)
 574 {
 575   /* Get the command name and prefix. */
 576   if (token != T_STRING && token != T_ID)
 577     error ("Command name expected.");
 578   cmdname = xstrdup (tokstr);
 579   lex_get ();
 580   skip_token ('(');
 581   force_id ();
 582   prefix = xstrdup (tokstr);
 583   lex_get ();
 584   skip_token (')');
 585   skip_token (':');
 586
 587   /* Read all the subcommands. */
 588   subcommands = NULL;
 589   def = NULL;
 590   parse_subcommands ();
 591 }
 592
 593 /* Parses a single setting into S, given subcommand information SBC
 594    and specifier information SPEC. */
 595 static void
 596 parse_setting (setting *s, specifier *spec)
 597 {
 598   s->parent = spec;
 599
 600   if (match_token ('*'))
 601     {
 602       if (spec->omit_kw)
 603         error ("Cannot have two settings with omittable keywords.");
 604       else
 605         spec->omit_kw = s;
 606     }
 607
 608   if (match_token ('!'))
 609     {
 610       if (spec->def)
 611         error ("Cannot have two default settings.");
 612       else
 613         spec->def = s;
 614     }
 615
 616   force_id ();
 617   s->specname = xstrdup (tokstr);
 618   s->con = add_symbol (s->specname, 0, 0);
 619   s->value = VAL_NONE;
 620
 621   lex_get ();
 622
 623   /* Parse setting value info if necessary. */
 624   if (token != '/' && token != ';' && token != '.' && token != ',')
 625     {
 626       if (token == '(')
 627         {
 628           s->valtype = VT_PAREN;
 629           lex_get ();
 630         }
 631       else
 632         s->valtype = VT_PLAIN;
 633
 634       s->optvalue = match_token ('*');
 635
 636       if (match_id ("N"))
 637         s->value = VAL_INT;
 638       else if (match_id ("D"))
 639         s->value = VAL_DBL;
 640       else
 641         error ("`n' or `d' expected.");
 642
 643       skip_token (':');
 644
 645       force_id ();
 646       s->valname = xstrdup (tokstr);
 647       lex_get ();
 648
 649       if (token == ',')
 650         {
 651           lex_get ();
 652           force_string ();
 653           s->restriction = xstrdup (tokstr);
 654           lex_get ();
 655         }
 656       else
 657         s->restriction = NULL;
 658
 659       if (s->valtype == VT_PAREN)
 660         skip_token (')');
 661     }
 662 }
 663
 664 /* Parse a single specifier into SPEC, given subcommand information
 665    SBC. */
 666 static void
 667 parse_specifier (specifier *spec, subcommand *sbc)
 668 {
 669   spec->index = 0;
 670   spec->s = NULL;
 671   spec->def = NULL;
 672   spec->omit_kw = NULL;
 673   spec->varname = NULL;
 674
 675   if (token == T_ID)
 676     {
 677       spec->varname = xstrdup (st_lower (tokstr));
 678       lex_get ();
 679     }
 680
 681   /* Handle array elements. */
 682   if (token != ':')
 683     {
 684       spec->index = sbc->narray;
 685       if (sbc->type == SBC_ARRAY)
 686         {
 687           if (token == '|')
 688             token = ',';
 689           else
 690             sbc->narray++;
 691         }
 692       spec->s = NULL;
 693       return;
 694     }
 695   skip_token (':');
 696
 697   /* Parse all the settings. */
 698   {
 699     setting **s = &spec->s;
 700
 701     for (;;)
 702       {
 703         *s = xmalloc (sizeof (setting));
 704         parse_setting (*s, spec);
 705         if (token == ',' || token == ';' || token == '.')
 706           break;
 707         skip_token ('/');
 708         s = &(*s)->next;
 709       }
 710     (*s)->next = NULL;
 711   }
 712 }
 713
 714 /* Parse a list of specifiers for subcommand SBC. */
 715 static void
 716 parse_specifiers (subcommand *sbc)
 717 {
 718   specifier **spec = &sbc->spec;
 719
 720   if (token == ';' || token == '.')
 721     {
 722       *spec = NULL;
 723       return;
 724     }
 725
 726   for (;;)
 727     {
 728       *spec = xmalloc (sizeof (specifier));
 729       parse_specifier (*spec, sbc);
 730       if (token == ';' || token == '.')
 731         break;
 732       skip_token (',');
 733       spec = &(*spec)->next;
 734     }
 735   (*spec)->next = NULL;
 736 }
 737
 738 /* Parse a subcommand into SBC. */
 739 static void
 740 parse_subcommand (subcommand *sbc)
 741 {
 742   if (match_token ('*'))
 743     {
 744       if (def)
 745         error ("Multiple default subcommands.");
 746       def = sbc;
 747     }
 748
 749   sbc->once = match_token ('+');
 750
 751   force_id ();
 752   sbc->name = xstrdup (tokstr);
 753   lex_get ();
 754
 755   sbc->narray = 0;
 756   sbc->type = SBC_PLAIN;
 757   sbc->spec = NULL;
 758
 759   if (match_token ('['))
 760     {
 761       force_id ();
 762       sbc->prefix = xstrdup (st_lower (tokstr));
 763       lex_get ();
 764
 765       skip_token (']');
 766       skip_token ('=');
 767
 768       sbc->type = SBC_ARRAY;
 769       parse_specifiers (sbc);
 770     }
 771   else
 772     {
 773       if (match_token ('('))
 774         {
 775           force_id ();
 776           sbc->prefix = xstrdup (st_lower (tokstr));
 777           lex_get ();
 778
 779           skip_token (')');
 780         }
 781       else
 782         sbc->prefix = "";
 783
 784       skip_token ('=');
 785
 786       if (match_id ("VAR"))
 787         sbc->type = SBC_VAR;
 788       if (match_id ("VARLIST"))
 789         {
 790           if (match_token ('('))
 791             {
 792               force_string ();
 793               sbc->message = xstrdup (tokstr);
 794               lex_get();
 795
 796               skip_token (')');
 797             }
 798           else sbc->message = NULL;
 799
 800           sbc->type = SBC_VARLIST;
 801         }
 802       else if (match_id ("INTEGER"))
 803         sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
 804       else if (match_id ("PINT"))
 805         sbc->type = SBC_PINT;
 806       else if (match_id ("DOUBLE"))
 807         sbc->type = match_id ("LIST") ? SBC_DBL_LIST : SBC_DBL;
 808       else if (match_id ("STRING"))
 809         {
 810           sbc->type = SBC_STRING;
 811           if (token == T_STRING)
 812             {
 813               sbc->restriction = xstrdup (tokstr);
 814               lex_get ();
 815               force_string ();
 816               sbc->message = xstrdup (tokstr);
 817               lex_get ();
 818             }
 819           else
 820             sbc->restriction = NULL;
 821         }
 822       else if (match_id ("CUSTOM"))
 823         sbc->type = SBC_CUSTOM;
 824       else
 825         parse_specifiers (sbc);
 826     }
 827 }
 828
 829 /* Parse all the subcommands. */
 830 void
 831 parse_subcommands (void)
 832 {
 833   subcommand **sbc = &subcommands;
 834
 835   for (;;)
 836     {
 837       *sbc = xmalloc (sizeof (subcommand));
 838       (*sbc)->next = NULL;
 839
 840       parse_subcommand (*sbc);
 841
 842       if (token == '.')
 843         return;
 844
 845       skip_token (';');
 846       sbc = &(*sbc)->next;
 847     }
 848 }
 849 \f
 850 /* Output. */
 851
 852 #define BASE_INDENT 2           /* Starting indent. */
 853 #define INC_INDENT 2            /* Indent increment. */
 854
 855 /* Increment the indent. */
 856 #define indent() indent += INC_INDENT
 857 #define outdent() indent -= INC_INDENT
 858
 859 /* Size of the indent from the left margin. */
 860 int indent;
 861
 862 #if __GNUC__ >= 2
 863 void dump (int, const char *, ...) __attribute__ ((format (printf, 2, 3)));
 864 #endif
 865
 866 /* Write line FORMAT to the output file, formatted as with printf,
 867    indented `indent' characters from the left margin.  If INDENTION is
 868    greater than 0, indents BASE_INDENT * INDENTION characters after
 869    writing the line; if INDENTION is less than 0, dedents BASE_INDENT
 870    * INDENTION characters _before_ writing the line. */
 871 void
 872 dump (int indention, const char *format, ...)
 873 {
 874   va_list args;
 875   int i;
 876
 877   if (indention < 0)
 878     indent += BASE_INDENT * indention;
 879
 880   oln++;
 881   va_start (args, format);
 882   for (i = 0; i < indent; i++)
 883     putc (' ', out);
 884   vfprintf (out, format, args);
 885   putc ('\n', out);
 886   va_end (args);
 887
 888   if (indention > 0)
 889     indent += BASE_INDENT * indention;
 890 }
 891
 892 /* Write the structure members for specifier SPEC to the output file.
 893    SBC is the including subcommand. */
 894 static void
 895 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
 896 {
 897   if (spec->varname)
 898     dump (0, "long %s%s;", sbc->prefix, spec->varname);
 899
 900   {
 901     setting *s;
 902
 903     for (s = spec->s; s; s = s->next)
 904       {
 905         if (s->value != VAL_NONE)
 906           {
 907             const char *typename;
 908
 909             assert (s->value == VAL_INT || s->value == VAL_DBL);
 910             typename = s->value == VAL_INT ? "long" : "double";
 911
 912             dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
 913           }
 914       }
 915   }
 916 }
 917
 918 /* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
 919 static int
 920 is_keyword (const char *t)
 921 {
 922   static const char *kw[] =
 923     {
 924       "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
 925       "NE", "ALL", "BY", "TO", "WITH", 0,
 926     };
 927   const char **cp;
 928
 929   for (cp = kw; *cp; cp++)
 930     if (!strcmp (t, *cp))
 931       return 1;
 932   return 0;
 933 }
 934
 935 /* Transforms a string NAME into a valid C identifier: makes
 936    everything lowercase and maps nonalphabetic characters to
 937    underscores.  Returns a pointer to a static buffer. */
 938 static char *
 939 make_identifier (const char *name)
 940 {
 941   char *p = get_buffer ();
 942   char *cp;
 943
 944   for (cp = p; *name; name++)
 945     if (isalpha ((unsigned char) *name))
 946       *cp++ = tolower ((unsigned char) (*name));
 947     else
 948       *cp++ = '_';
 949   *cp = '\0';
 950
 951   return p;
 952 }
 953
 954 /* Writes the struct and enum declarations for the parser. */
 955 static void
 956 dump_declarations (void)
 957 {
 958   indent = 0;
 959
 960   /* Write out enums for all the identifiers in the symbol table. */
 961   {
 962     int f, k;
 963     symbol *sym;
 964     char *buf = NULL;
 965
 966     /* Note the squirmings necessary to make sure that the last enum
 967        is not followed by a comma, as mandated by ANSI C89. */
 968     for (sym = symtab, f = k = 0; sym; sym = sym->next)
 969       if (!sym->unique && !is_keyword (sym->name))
 970         {
 971           if (!f)
 972             {
 973               dump (0, "/* Settings for subcommand specifiers. */");
 974               dump (1, "enum");
 975               dump (1, "{");
 976               f = 1;
 977             }
 978
 979           if (buf == NULL)
 980             buf = xmalloc (1024);
 981           else
 982             dump (0, buf);
 983
 984           if (k)
 985             sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
 986           else
 987             {
 988               k = 1;
 989               sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
 990             }
 991         }
 992     if (buf)
 993       {
 994         buf[strlen (buf) - 1] = 0;
 995         dump (0, buf);
 996         free (buf);
 997       }
 998     if (f)
 999       {
1000         dump (-1, "};");
1001         dump (-1, nullstr);
1002       }
1003   }
1004
1005   /* For every array subcommand, write out the associated enumerated
1006      values. */
1007   {
1008     subcommand *sbc;
1009
1010     for (sbc = subcommands; sbc; sbc = sbc->next)
1011       if (sbc->type == SBC_ARRAY && sbc->narray)
1012         {
1013           dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1014
1015           dump (1, "enum");
1016           dump (1, "{");
1017
1018           {
1019             specifier *spec;
1020
1021             for (spec = sbc->spec; spec; spec = spec->next)
1022               if (!spec->s)
1023                 dump (0, "%s%s%s = %d,",
1024                       st_upper (prefix), st_upper (sbc->prefix),
1025                       st_upper (spec->varname), spec->index);
1026
1027             dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1028
1029             dump (-1, "};");
1030             dump (-1, nullstr);
1031           }
1032         }
1033   }
1034
1035   /* Write out structure declaration. */
1036   {
1037     subcommand *sbc;
1038
1039     dump (0, "/* %s structure. */", cmdname);
1040     dump (1, "struct cmd_%s", make_identifier (cmdname));
1041     dump (1, "{");
1042     for (sbc = subcommands; sbc; sbc = sbc->next)
1043       {
1044         int f = 0;
1045
1046         if (sbc != subcommands)
1047           dump (0, nullstr);
1048
1049         dump (0, "/* %s subcommand. */", sbc->name);
1050         dump (0, "int sbc_%s;", st_lower (sbc->name));
1051
1052         switch (sbc->type)
1053           {
1054           case SBC_ARRAY:
1055           case SBC_PLAIN:
1056             {
1057               specifier *spec;
1058
1059               for (spec = sbc->spec; spec; spec = spec->next)
1060                 {
1061                   if (spec->s == 0)
1062                     {
1063                       if (sbc->type == SBC_PLAIN)
1064                         dump (0, "long int %s%s;", st_lower (sbc->prefix),
1065                               spec->varname);
1066                       else if (f == 0)
1067                         {
1068                           dump (0, "int a_%s[%d];",
1069                                 st_lower (sbc->name), sbc->narray);
1070                           f = 1;
1071                         }
1072                     }
1073                   else
1074                     dump_specifier_vars (spec, sbc);
1075                 }
1076             }
1077             break;
1078
1079           case SBC_VARLIST:
1080             dump (0, "int %sn_%s;", st_lower (sbc->prefix),
1081                   st_lower (sbc->name));
1082             dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
1083                   st_lower (sbc->name));
1084             break;
1085
1086           case SBC_VAR:
1087             dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
1088                   st_lower (sbc->name));
1089             break;
1090
1091           case SBC_STRING:
1092             dump (0, "char *s_%s;", st_lower (sbc->name));
1093             break;
1094
1095           case SBC_INT:
1096           case SBC_PINT:
1097             dump (0, "long n_%s;", st_lower (sbc->name));
1098             break;
1099
1100           default:;
1101             /* nothing */
1102           }
1103       }
1104
1105     dump (-1, "};");
1106     dump (-1, nullstr);
1107   }
1108
1109   /* Write out prototypes for custom_*() functions as necessary. */
1110   {
1111     int seen = 0;
1112     subcommand *sbc;
1113
1114     for (sbc = subcommands; sbc; sbc = sbc->next)
1115       if (sbc->type == SBC_CUSTOM)
1116         {
1117           if (!seen)
1118             {
1119               seen = 1;
1120               dump (0, "/* Prototype for custom subcommands of %s. */",
1121                     cmdname);
1122             }
1123           dump (0, "static int %scustom_%s (struct cmd_%s *);",
1124                 st_lower (prefix), st_lower (sbc->name),
1125                 make_identifier (cmdname));
1126         }
1127
1128     if (seen)
1129       dump (0, nullstr);
1130   }
1131
1132   /* Prototypes for parsing and freeing functions. */
1133   {
1134     dump (0, "/* Command parsing functions. */");
1135     dump (0, "static int parse_%s (struct cmd_%s *);",
1136           make_identifier (cmdname), make_identifier (cmdname));
1137     dump (0, "static void free_%s (struct cmd_%s *);",
1138           make_identifier (cmdname), make_identifier (cmdname));
1139     dump (0, nullstr);
1140   }
1141 }
1142
1143 /* Writes out code to initialize all the variables that need
1144    initialization for particular specifier SPEC inside subcommand SBC. */
1145 static void
1146 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1147 {
1148   if (spec->varname)
1149     {
1150       char s[256];
1151
1152       if (spec->def)
1153         sprintf (s, "%s%s",
1154                  st_upper (prefix), find_symbol (spec->def->con)->name);
1155       else
1156         strcpy (s, "-1");
1157       dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1158     }
1159
1160   {
1161     setting *s;
1162
1163     for (s = spec->s; s; s = s->next)
1164       {
1165         if (s->value != VAL_NONE)
1166           {
1167             const char *init;
1168
1169             assert (s->value == VAL_INT || s->value == VAL_DBL);
1170             init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
1171
1172             dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1173           }
1174       }
1175   }
1176 }
1177
1178 /* Write code to initialize all variables. */
1179 static void
1180 dump_vars_init (void)
1181 {
1182   /* Loop through all the subcommands. */
1183   {
1184     subcommand *sbc;
1185
1186     for (sbc = subcommands; sbc; sbc = sbc->next)
1187       {
1188         int f = 0;
1189
1190         dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1191         switch (sbc->type)
1192           {
1193           case SBC_DBL:
1194           case SBC_INT_LIST:
1195           case SBC_DBL_LIST:
1196           case SBC_CUSTOM:
1197             /* nothing */
1198             break;
1199
1200           case SBC_PLAIN:
1201           case SBC_ARRAY:
1202             {
1203               specifier *spec;
1204
1205               for (spec = sbc->spec; spec; spec = spec->next)
1206                 if (spec->s == NULL)
1207                   {
1208                     if (sbc->type == SBC_PLAIN)
1209                       dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1210                     else if (f == 0)
1211                       {
1212                         dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1213                               st_lower (sbc->name), st_lower (sbc->name));
1214                         f = 1;
1215                       }
1216                   }
1217                 else
1218                   dump_specifier_init (spec, sbc);
1219             }
1220             break;
1221
1222           case SBC_VARLIST:
1223             dump (0, "p->%sn_%s = 0;",
1224                   st_lower (sbc->prefix), st_lower (sbc->name));
1225             dump (0, "p->%sv_%s = NULL;",
1226                   st_lower (sbc->prefix), st_lower (sbc->name));
1227             break;
1228
1229           case SBC_VAR:
1230             dump (0, "p->%sv_%s = NULL;",
1231                   st_lower (sbc->prefix), st_lower (sbc->name));
1232             break;
1233
1234           case SBC_STRING:
1235             dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1236             break;
1237
1238           case SBC_INT:
1239           case SBC_PINT:
1240             dump (0, "p->n_%s = NOT_LONG;", st_lower (sbc->name));
1241             break;
1242
1243           default:
1244             assert (0);
1245           }
1246       }
1247   }
1248 }
1249
1250 /* Return a pointer to a static buffer containing an expression that
1251    will match token T. */
1252 static char *
1253 make_match (const char *t)
1254 {
1255   char *s;
1256
1257   s = get_buffer ();
1258
1259   while (*t == '_')
1260     t++;
1261
1262   if (is_keyword (t))
1263     sprintf (s, "lex_match (T_%s)", t);
1264   else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1265     strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
1266             "|| lex_match_id (\"TRUE\"))");
1267   else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1268     strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
1269             "|| lex_match_id (\"FALSE\"))");
1270   else if (isdigit ((unsigned char) t[0]))
1271     sprintf (s, "lex_match_int (%s)", t);
1272   else
1273     sprintf (s, "lex_match_id (\"%s\")", t);
1274
1275   return s;
1276 }
1277
1278 /* Write out the parsing code for specifier SPEC within subcommand
1279    SBC. */
1280 static void
1281 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1282 {
1283   setting *s;
1284
1285   if (spec->omit_kw && spec->omit_kw->next)
1286     error ("Omittable setting is not last setting in `%s' specifier.",
1287            spec->varname);
1288   if (spec->omit_kw && spec->omit_kw->parent->next)
1289     error ("Default specifier is not in last specifier in `%s' "
1290            "subcommand.", sbc->name);
1291
1292   for (s = spec->s; s; s = s->next)
1293     {
1294       int first = spec == sbc->spec && s == spec->s;
1295
1296       /* Match the setting's keyword. */
1297       if (spec->omit_kw == s)
1298         {
1299           if (!first)
1300             {
1301               dump (1, "else");
1302               dump (1, "{");
1303             }
1304           dump (1, "%s;", make_match (s->specname));
1305         }
1306       else
1307         dump (1, "%sif (%s)", first ? "" : "else ",
1308               make_match (s->specname));
1309
1310       /* Handle values. */
1311       if (s->value == VAL_NONE)
1312         dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1313               st_upper (prefix), find_symbol (s->con)->name);
1314       else
1315         {
1316           if (spec->omit_kw != s)
1317             dump (1, "{");
1318
1319           if (spec->varname)
1320             dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1321                   st_upper (prefix), find_symbol (s->con)->name);
1322
1323           if (s->valtype == VT_PAREN)
1324             {
1325               if (s->optvalue)
1326                 {
1327                   dump (1, "if (lex_match ('('))");
1328                   dump (1, "{");
1329                 }
1330               else
1331                 {
1332                   dump (1, "if (!lex_match ('('))");
1333                   dump (1, "{");
1334                   dump (0, "msg (SE, _(\"`(' expected after %s "
1335                         "specifier of %s subcommand.\"));",
1336                         s->specname, sbc->name);
1337                   dump (0, "goto lossage;");
1338                   dump (-1, "}");
1339                   outdent ();
1340                 }
1341             }
1342
1343           if (s->value == VAL_INT)
1344             {
1345               dump (1, "if (!lex_integer_p ())");
1346               dump (1, "{");
1347               dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1348                     "requires an integer argument.\"));",
1349                     s->specname, sbc->name);
1350               dump (0, "goto lossage;");
1351               dump (-1, "}");
1352               dump (-1, "p->%s%s = lex_integer ();",
1353                     sbc->prefix, st_lower (s->valname));
1354             }
1355           else
1356             {
1357               dump (1, "if (token != T_NUM)");
1358               dump (1, "{");
1359               dump (0, "msg (SE, _(\"Number expected after %s "
1360                     "specifier of %s subcommand.\"));",
1361                     s->specname, sbc->name);
1362               dump (0, "goto lossage;");
1363               dump (-1, "}");
1364               dump (-1, "p->%s%s = tokval;", sbc->prefix,
1365                     st_lower (s->valname));
1366             }
1367
1368           if (s->restriction)
1369             {
1370               {
1371                 char *str, *str2;
1372                 str = xmalloc (MAX_TOK_LEN);
1373                 str2 = xmalloc (MAX_TOK_LEN);
1374                 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1375                 sprintf (str, s->restriction, str2, str2, str2, str2,
1376                          str2, str2, str2, str2);
1377                 dump (1, "if (!(%s))", str);
1378                 free (str);
1379                 free (str2);
1380               }
1381
1382               dump (1, "{");
1383               dump (0, "msg (SE, _(\"Bad argument for %s "
1384                     "specifier of %s subcommand.\"));",
1385                     s->specname, sbc->name);
1386               dump (0, "goto lossage;");
1387               dump (-1, "}");
1388               outdent ();
1389             }
1390
1391           dump (0, "lex_get ();");
1392
1393           if (s->valtype == VT_PAREN)
1394             {
1395               dump (1, "if (!lex_match (')'))");
1396               dump (1, "{");
1397               dump (0, "msg (SE, _(\"`)' expected after argument for "
1398                     "%s specifier of %s.\"));",
1399                     s->specname, sbc->name);
1400               dump (0, "goto lossage;");
1401               dump (-1, "}");
1402               outdent ();
1403               if (s->optvalue)
1404                 {
1405                   dump (-1, "}");
1406                   outdent ();
1407                 }
1408             }
1409
1410           if (s != spec->omit_kw)
1411             dump (-1, "}");
1412         }
1413
1414       if (s == spec->omit_kw)
1415         {
1416           dump (-1, "}");
1417           outdent ();
1418         }
1419       outdent ();
1420     }
1421 }
1422
1423 /* Write out the code to parse subcommand SBC. */
1424 static void
1425 dump_subcommand (const subcommand *sbc)
1426 {
1427   if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1428     {
1429       int count;
1430
1431       dump (1, "while (token != '/' && token != '.')");
1432       dump (1, "{");
1433
1434       {
1435         specifier *spec;
1436
1437         for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1438           {
1439             if (spec->s)
1440               dump_specifier_parse (spec, sbc);
1441             else
1442               {
1443                 count++;
1444                 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1445                       make_match (st_upper (spec->varname)));
1446                 if (sbc->type == SBC_PLAIN)
1447                   dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1448                         spec->varname);
1449                 else
1450                   dump (0, "p->a_%s[%s%s%s] = 1;",
1451                         st_lower (sbc->name),
1452                         st_upper (prefix), st_upper (sbc->prefix),
1453                         st_upper (spec->varname));
1454                 outdent ();
1455               }
1456           }
1457       }
1458
1459       {
1460         specifier *spec;
1461         setting *s;
1462
1463         /* This code first finds the last specifier in sbc.  Then it
1464            finds the last setting within that last specifier.  Either
1465            or both might be NULL. */
1466         spec = sbc->spec;
1467         s = NULL;
1468         if (spec)
1469           {
1470             while (spec->next)
1471               spec = spec->next;
1472             s = spec->s;
1473             if (s)
1474               while (s->next)
1475                 s = s->next;
1476           }
1477
1478         if (spec && (!spec->s || !spec->omit_kw))
1479           {
1480             dump (1, "else");
1481             dump (1, "{");
1482             dump (0, "lex_error (NULL);");
1483             dump (0, "goto lossage;");
1484             dump (-1, "}");
1485             outdent ();
1486           }
1487       }
1488
1489       dump (0, "lex_match (',');");
1490       dump (-1, "}");
1491       outdent ();
1492     }
1493   else if (sbc->type == SBC_VARLIST)
1494     {
1495       dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1496             "PV_APPEND%s%s))",
1497             st_lower (sbc->prefix), st_lower (sbc->name),
1498             st_lower (sbc->prefix), st_lower (sbc->name),
1499             sbc->message ? " |" : "",
1500             sbc->message ? sbc->message : "");
1501       dump (0, "goto lossage;");
1502       outdent ();
1503     }
1504   else if (sbc->type == SBC_VAR)
1505     {
1506       dump (0, "p->%sv_%s = parse_variable ();",
1507             st_lower (sbc->prefix), st_lower (sbc->name));
1508       dump (1, "if (p->%sv_%s)",
1509             st_lower (sbc->prefix), st_lower (sbc->name));
1510       dump (0, "goto lossage;");
1511       outdent ();
1512     }
1513   else if (sbc->type == SBC_STRING)
1514     {
1515       if (sbc->restriction)
1516         {
1517           dump (1, "{");
1518           dump (0, "int x;");
1519         }
1520       dump (1, "if (!lex_force_string ())");
1521       dump (0, "return 0;");
1522       outdent ();
1523       if (sbc->restriction)
1524         {
1525           dump (0, "x = ds_length (&tokstr);");
1526           dump (1, "if (!(%s))", sbc->restriction);
1527           dump (1, "{");
1528           dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1529                 sbc->name, sbc->message);
1530           dump (0, "goto lossage;");
1531           dump (-1, "}");
1532           outdent ();
1533         }
1534       dump (0, "p->s_%s = xstrdup (ds_value (&tokstr));",
1535             st_lower (sbc->name));
1536       dump (0, "lex_get ();");
1537       if (sbc->restriction)
1538         dump (-1, "}");
1539     }
1540   else if (sbc->type == SBC_INT)
1541     {
1542       dump (1, "if (!lex_force_int ())");
1543       dump (0, "goto lossage;");
1544       dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1545     }
1546   else if (sbc->type == SBC_PINT)
1547     {
1548       dump (0, "lex_match ('(');");
1549       dump (1, "if (!lex_force_int ())");
1550       dump (0, "goto lossage;");
1551       dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1552       dump (0, "lex_match (')');");
1553     }
1554   else if (sbc->type == SBC_CUSTOM)
1555     {
1556       dump (1, "switch (%scustom_%s (p))",
1557             st_lower (prefix), st_lower (sbc->name));
1558       dump (0, "{");
1559       dump (1, "case 0:");
1560       dump (0, "goto lossage;");
1561       dump (-1, "case 1:");
1562       indent ();
1563       dump (0, "break;");
1564       dump (-1, "case 2:");
1565       indent ();
1566       dump (0, "lex_error (NULL);");
1567       dump (0, "goto lossage;");
1568       dump (-1, "default:");
1569       indent ();
1570       dump (0, "assert (0);");
1571       dump (-1, "}");
1572       outdent ();
1573     }
1574 }
1575
1576 /* Write out entire parser. */
1577 static void
1578 dump_parser (void)
1579 {
1580   int f;
1581
1582   indent = 0;
1583
1584   dump (0, "static int");
1585   dump (0, "parse_%s (struct cmd_%s *p)", make_identifier (cmdname),
1586         make_identifier (cmdname));
1587   dump (1, "{");
1588
1589   dump_vars_init ();
1590
1591   dump (1, "for (;;)");
1592   dump (1, "{");
1593
1594   f = 0;
1595   if (def && (def->type == SBC_VARLIST))
1596     {
1597       if (def->type == SBC_VARLIST)
1598         dump (1, "if (token == T_ID "
1599               "&& dict_lookup_var (default_dict, tokid) != NULL "
1600               "&& lex_look_ahead () != '=')");
1601       else
1602         {
1603           dump (0, "if ((token == T_ID "
1604                 "&& dict_lookup_var (default_dict, tokid) "
1605                 "&& lex_look_ahead () != '=')");
1606           dump (1, "     || token == T_ALL)");
1607         }
1608       dump (1, "{");
1609       dump (0, "p->sbc_%s++;", st_lower (def->name));
1610       dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1611             "PV_APPEND))",
1612             st_lower (def->prefix), st_lower (def->name),
1613             st_lower (def->prefix), st_lower (def->name));
1614       dump (0, "goto lossage;");
1615       dump (-2, "}");
1616       outdent ();
1617       f = 1;
1618     }
1619   else if (def && def->type == SBC_CUSTOM)
1620     {
1621       dump (1, "switch (%scustom_%s (p))",
1622             st_lower (prefix), st_lower (def->name));
1623       dump (0, "{");
1624       dump (1, "case 0:");
1625       dump (0, "goto lossage;");
1626       dump (-1, "case 1:");
1627       indent ();
1628       dump (0, "p->sbc_%s++;", st_lower (def->name));
1629       dump (0, "continue;");
1630       dump (-1, "case 2:");
1631       indent ();
1632       dump (0, "break;");
1633       dump (-1, "default:");
1634       indent ();
1635       dump (0, "assert (0);");
1636       dump (-1, "}");
1637       outdent ();
1638     }
1639
1640   {
1641     subcommand *sbc;
1642
1643     for (sbc = subcommands; sbc; sbc = sbc->next)
1644       {
1645         dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1646         f = 1;
1647         dump (1, "{");
1648
1649         dump (0, "lex_match ('=');");
1650         dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1651         if (sbc->once)
1652           {
1653             dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1654             dump (1, "{");
1655             dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1656                   sbc->name);
1657             dump (0, "goto lossage;");
1658             dump (-1, "}");
1659             outdent ();
1660           }
1661         dump_subcommand (sbc);
1662         dump (-1, "}");
1663         outdent ();
1664       }
1665   }
1666
1667   dump (1, "if (!lex_match ('/'))");
1668   dump (0, "break;");
1669   dump (-2, "}");
1670   outdent ();
1671   dump (0, nullstr);
1672   dump (1, "if (token != '.')");
1673   dump (1, "{");
1674   dump (0, "lex_error (_(\"expecting end of command\"));");
1675   dump (0, "goto lossage;");
1676   dump (-1, "}");
1677   dump (0, nullstr);
1678   dump (-1, "return 1;");
1679   dump (0, nullstr);
1680   dump (-1, "lossage:");
1681   indent ();
1682   dump (0, "free_%s (p);", make_identifier (cmdname));
1683   dump (0, "return 0;");
1684   dump (-1, "}");
1685   dump (0, nullstr);
1686 }
1687
1688 /* Write the output file header. */
1689 static void
1690 dump_header (void)
1691 {
1692   time_t curtime;
1693   struct tm *loctime;
1694   char *timep;
1695
1696   indent = 0;
1697   curtime = time (NULL);
1698   loctime = localtime (&curtime);
1699   timep = asctime (loctime);
1700   timep[strlen (timep) - 1] = 0;
1701   dump (0,   "/* %s", ofn);
1702   dump (0, nullstr);
1703   dump (0, "   Generated by q2c from %s on %s.", ifn, timep);
1704   dump (0, "   Do not modify!");
1705   dump (0, " */");
1706   dump (0, nullstr);
1707 }
1708
1709 /* Write out commands to free variable state. */
1710 static void
1711 dump_free (void)
1712 {
1713   subcommand *sbc;
1714   int used;
1715
1716   indent = 0;
1717
1718   used = 0;
1719   for (sbc = subcommands; sbc; sbc = sbc->next)
1720     if (sbc->type == SBC_STRING)
1721       used = 1;
1722
1723   dump (0, "static void");
1724   dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1725         make_identifier (cmdname), used ? "" : " unused");
1726   dump (1, "{");
1727
1728   for (sbc = subcommands; sbc; sbc = sbc->next)
1729     if (sbc->type == SBC_STRING)
1730       dump (0, "free (p->s_%s);", st_lower (sbc->name));
1731
1732   dump (-1, "}");
1733 }
1734
1735 /* Returns the name of a directive found on the current input line, if
1736    any, or a null pointer if none found. */
1737 static const char *
1738 recognize_directive (void)
1739 {
1740   static char directive[16];
1741   char *sp, *ep;
1742
1743   sp = skip_ws (buf);
1744   if (strncmp (sp, "/*", 2))
1745     return NULL;
1746   sp = skip_ws (sp + 2);
1747   if (*sp != '(')
1748     return NULL;
1749   sp++;
1750
1751   ep = strchr (sp, ')');
1752   if (ep == NULL)
1753     return NULL;
1754
1755   if (ep - sp > 15)
1756     ep = sp + 15;
1757   memcpy (directive, sp, ep - sp);
1758   directive[ep - sp] = '\0';
1759   return directive;
1760 }
1761
1762 int
1763 main (int argc, char *argv[])
1764 {
1765   pgmname = argv[0];
1766   if (argc != 3)
1767     fail ("Syntax: q2c input.q output.c");
1768
1769   ifn = argv[1];
1770   in = fopen (ifn, "r");
1771   if (!in)
1772     fail ("%s: open: %s.", ifn, strerror (errno));
1773
1774   ofn = argv[2];
1775   out = fopen (ofn, "w");
1776   if (!out)
1777     fail ("%s: open: %s.", ofn, strerror (errno));
1778
1779   is_open = 1;
1780   buf = xmalloc (MAX_LINE_LEN);
1781   tokstr = xmalloc (MAX_TOK_LEN);
1782
1783   dump_header ();
1784
1785   indent = 0;
1786   dump (0, "#line %d \"%s\"", ln + 1, ifn);
1787   while (get_line ())
1788     {
1789       const char *directive = recognize_directive ();
1790       if (directive == NULL)
1791         {
1792           dump (0, "%s", buf);
1793           continue;
1794         }
1795
1796       dump (0, "#line %d \"%s\"", oln - 1, ofn);
1797       if (!strcmp (directive, "specification"))
1798         {
1799           /* Skip leading slash-star line. */
1800           get_line ();
1801           lex_get ();
1802
1803           parse ();
1804
1805           /* Skip trailing star-slash line. */
1806           get_line ();
1807         }
1808       else if (!strcmp (directive, "headers"))
1809         {
1810           indent = 0;
1811
1812           dump (0, "#include <assert.h>");
1813           dump (0, "#include <stdlib.h>");
1814           dump (0, "#include \"alloc.h\"");
1815           dump (0, "#include \"error.h\"");
1816           dump (0, "#include \"lexer.h\"");
1817           dump (0, "#include \"str.h\"");
1818           dump (0, "#include \"var.h\"");
1819           dump (0, nullstr);
1820         }
1821       else if (!strcmp (directive, "declarations"))
1822         dump_declarations ();
1823       else if (!strcmp (directive, "functions"))
1824         {
1825           dump_parser ();
1826           dump_free ();
1827         }
1828       else
1829         error ("unknown directive `%s'", directive);
1830       indent = 0;
1831       dump (0, "#line %d \"%s\"", ln + 1, ifn);
1832     }
1833
1834   return EXIT_SUCCESS;
1835 }
1836