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