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