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