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