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