src/q2c.c

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