pintos-os.org Git - pspp/blob - src/language/lexer/q2c.c

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