src/language/lexer/q2c.c

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