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                         "NULL_SENTINEL);");
1467                   dump (0, "goto lossage;");
1468                   dump (-1, "}");
1469                   outdent ();
1470                 }
1471             }
1472
1473           if (s->value == VAL_INT)
1474             {
1475               dump (1, "if (!lex_force_int (lexer))");
1476               dump (0, "goto lossage;");
1477               dump (-1, "p->%s%s = lex_integer (lexer);",
1478                     sbc->prefix, st_lower (s->valname));
1479             }
1480           else if (s->value == VAL_DBL)
1481             {
1482               dump (1, "if (!lex_force_num (lexer))");
1483               dump (0, "goto lossage;");
1484               dump (-1, "p->%s%s = lex_tokval (lexer);", sbc->prefix,
1485                     st_lower (s->valname));
1486             }
1487           else if (s->value == VAL_STRING)
1488             {
1489               dump (1, "if (!lex_force_string_or_id (lexer))");
1490               dump (0, "goto lossage;");
1491               dump (-1, "free (p->%s%s);", sbc->prefix, st_lower (s->valname));
1492               dump (0, "p->%s%s = ss_xstrdup (ss_tokss (lexer));",
1493                     sbc->prefix, st_lower (s->valname));
1494             }
1495           else
1496             abort ();
1497
1498           if (s->restriction)
1499             {
1500               {
1501                 char *str, *str2;
1502                 str = xmalloc (MAX_TOK_LEN);
1503                 str2 = xmalloc (MAX_TOK_LEN);
1504                 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1505                 sprintf (str, s->restriction, str2, str2, str2, str2,
1506                          str2, str2, str2, str2);
1507                 dump (1, "if (!(%s))", str);
1508                 free (str);
1509                 free (str2);
1510               }
1511
1512               dump (1, "{");
1513               dump (0, "lex_error (lexer, NULL);");
1514               dump (0, "goto lossage;");
1515               dump (-1, "}");
1516               outdent ();
1517             }
1518
1519           dump (0, "lex_get (lexer);");
1520
1521           if (s->valtype == VT_PAREN)
1522             {
1523               dump (1, "if (!lex_force_match (lexer, T_RPAREN))");
1524               dump (0, "goto lossage;");
1525               outdent ();
1526               if (s->optvalue)
1527                 {
1528                   dump (-1, "}");
1529                   outdent ();
1530                 }
1531             }
1532
1533           if (s != spec->omit_kw)
1534             dump (-1, "}");
1535         }
1536
1537       if (s == spec->omit_kw)
1538         {
1539           dump (-1, "}");
1540           outdent ();
1541         }
1542       outdent ();
1543     }
1544 }
1545
1546 /* Write out the code to parse subcommand SBC. */
1547 static void
1548 dump_subcommand (const subcommand *sbc)
1549 {
1550   if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1551     {
1552       int count;
1553
1554       dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1555       dump (1, "{");
1556
1557       {
1558         specifier *spec;
1559
1560         for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1561           {
1562             if (spec->s)
1563               dump_specifier_parse (spec, sbc);
1564             else
1565               {
1566                 count++;
1567                 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1568                       make_match (st_upper (spec->varname)));
1569                 if (sbc->type == SBC_PLAIN)
1570                   dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1571                         spec->varname);
1572                 else
1573                   dump (0, "p->a_%s[%s%s%s] = 1;",
1574                         st_lower (sbc->name),
1575                         st_upper (prefix), st_upper (sbc->prefix),
1576                         st_upper (spec->varname));
1577                 outdent ();
1578               }
1579           }
1580       }
1581
1582       {
1583         specifier *spec;
1584         setting *s;
1585
1586         /* This code first finds the last specifier in sbc.  Then it
1587            finds the last setting within that last specifier.  Either
1588            or both might be NULL. */
1589         spec = sbc->spec;
1590         s = NULL;
1591         if (spec)
1592           {
1593             while (spec->next)
1594               spec = spec->next;
1595             s = spec->s;
1596             if (s)
1597               while (s->next)
1598                 s = s->next;
1599           }
1600
1601         if (spec && (!spec->s || !spec->omit_kw))
1602           {
1603             dump (1, "else");
1604             dump (1, "{");
1605             dump (0, "lex_error (lexer, NULL);");
1606             dump (0, "goto lossage;");
1607             dump (-1, "}");
1608             outdent ();
1609           }
1610       }
1611
1612       dump (0, "lex_match (lexer, T_COMMA);");
1613       dump (-1, "}");
1614       outdent ();
1615     }
1616   else if (sbc->type == SBC_VARLIST)
1617     {
1618       dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1619             "PV_APPEND%s%s))",
1620             st_lower (sbc->prefix), st_lower (sbc->name),
1621             st_lower (sbc->prefix), st_lower (sbc->name),
1622             sbc->pv_options ? " |" : "",
1623             sbc->pv_options ? sbc->pv_options : "");
1624       dump (0, "goto lossage;");
1625       outdent ();
1626     }
1627   else if (sbc->type == SBC_VAR)
1628     {
1629       dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
1630             st_lower (sbc->prefix), st_lower (sbc->name));
1631       dump (1, "if (!p->%sv_%s)",
1632             st_lower (sbc->prefix), st_lower (sbc->name));
1633       dump (0, "goto lossage;");
1634       outdent ();
1635     }
1636   else if (sbc->type == SBC_STRING)
1637     {
1638       dump (1, "if (!lex_force_string (lexer))");
1639       dump (0, "return false;");
1640       outdent ();
1641       dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1642       dump (0, "p->s_%s = ss_xstrdup (lex_tokss (lexer));",
1643             st_lower (sbc->name));
1644       dump (0, "lex_get (lexer);");
1645     }
1646   else if (sbc->type == SBC_DBL)
1647     {
1648       dump (1, "if (!lex_force_num (lexer))");
1649       dump (0, "goto lossage;");
1650       dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
1651             st_lower (sbc->name), st_lower (sbc->name) );
1652       dump (0, "lex_get(lexer);");
1653     }
1654   else if (sbc->type == SBC_INT)
1655     {
1656       dump(1, "{");
1657       dump(0, "int x;");
1658       dump (1, "if (!lex_force_int (lexer))");
1659       dump (0, "goto lossage;");
1660       dump (-1, "x = lex_integer (lexer);");
1661       dump (0, "lex_get(lexer);");
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 (lexer, T_LPAREN);");
1668       dump (1, "if (!lex_force_int (lexer))");
1669       dump (0, "goto lossage;");
1670       dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
1671       dump (0, "lex_match (lexer, T_RPAREN);");
1672     }
1673   else if (sbc->type == SBC_DBL_LIST || sbc->type == SBC_INT_LIST)
1674     {
1675       dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1676       dump (1, "{");
1677       dump (0, "subc_list_error (lexer, \"%s\", MAXLISTS);",
1678             st_lower(sbc->name));
1679       dump (0, "goto lossage;");
1680       dump (-1,"}");
1681
1682       dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1683       dump (1, "{");
1684       dump (0, "lex_match (lexer, T_COMMA);");
1685       dump (0, "if (!lex_force_num (lexer))");
1686       dump (1, "{");
1687       dump (0, "goto lossage;");
1688       dump (-1,"}");
1689
1690       dump (0, "subc_list_%s_push (&p->%cl_%s[p->sbc_%s-1], lex_number (lexer));",
1691             sbc->type == SBC_INT_LIST ? "int" : "double",
1692             sbc->type == SBC_INT_LIST ? 'i' : 'd',
1693             st_lower (sbc->name), st_lower (sbc->name));
1694
1695       dump (0, "lex_get (lexer);");
1696       dump (-1,"}");
1697
1698     }
1699   else if (sbc->type == SBC_CUSTOM)
1700     {
1701       dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1702             st_lower (prefix), st_lower (sbc->name));
1703       dump (0, "{");
1704       dump (1, "case 0:");
1705       dump (0, "goto lossage;");
1706       dump (-1, "case 1:");
1707       indent ();
1708       dump (0, "break;");
1709       dump (-1, "case 2:");
1710       indent ();
1711       dump (0, "lex_error (lexer, NULL);");
1712       dump (0, "goto lossage;");
1713       dump (-1, "default:");
1714       indent ();
1715       dump (0, "NOT_REACHED ();");
1716       dump (-1, "}");
1717       outdent ();
1718     }
1719 }
1720
1721 /* Write out entire parser. */
1722 static void
1723 dump_parser (int persistent)
1724 {
1725   int f;
1726
1727   indent = 0;
1728
1729   dump (0, "static int");
1730   dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
1731         make_identifier (cmdname),
1732         (def && ( def->type == SBC_VARLIST && def->type == SBC_CUSTOM))?"":" UNUSED",
1733         make_identifier (cmdname));
1734   dump (1, "{");
1735
1736   dump_vars_init (persistent);
1737
1738   dump (1, "for (;;)");
1739   dump (1, "{");
1740
1741   f = 0;
1742   if (def && (def->type == SBC_VARLIST))
1743     {
1744       if (def->type == SBC_VARLIST)
1745         dump (1, "if (lex_token (lexer) == T_ID "
1746               "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) != NULL "
1747               "&& lex_next_token (lexer, 1) != T_EQUALS)");
1748       else
1749         {
1750           dump (0, "if ((lex_token (lexer) == T_ID "
1751                 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) "
1752                 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1753           dump (1, "     || token == T_ALL)");
1754         }
1755       dump (1, "{");
1756       dump (0, "p->sbc_%s++;", st_lower (def->name));
1757       dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1758             "PV_APPEND))",
1759             st_lower (def->prefix), st_lower (def->name),
1760             st_lower (def->prefix), st_lower (def->name));
1761       dump (0, "goto lossage;");
1762       dump (-2, "}");
1763       outdent ();
1764       f = 1;
1765     }
1766   else if (def && def->type == SBC_CUSTOM)
1767     {
1768       dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1769             st_lower (prefix), st_lower (def->name));
1770       dump (0, "{");
1771       dump (1, "case 0:");
1772       dump (0, "goto lossage;");
1773       dump (-1, "case 1:");
1774       indent ();
1775       dump (0, "p->sbc_%s++;", st_lower (def->name));
1776       dump (0, "continue;");
1777       dump (-1, "case 2:");
1778       indent ();
1779       dump (0, "break;");
1780       dump (-1, "default:");
1781       indent ();
1782       dump (0, "NOT_REACHED ();");
1783       dump (-1, "}");
1784       outdent ();
1785     }
1786
1787   {
1788     subcommand *sbc;
1789
1790     for (sbc = subcommands; sbc; sbc = sbc->next)
1791       {
1792         dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1793         f = 1;
1794         dump (1, "{");
1795
1796         dump (0, "lex_match (lexer, T_EQUALS);");
1797         dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1798         if (sbc->arity != ARITY_MANY)
1799           {
1800             dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1801             dump (1, "{");
1802             dump (0, "lex_sbc_only_once (\"%s\");", sbc->name);
1803             dump (0, "goto lossage;");
1804             dump (-1, "}");
1805             outdent ();
1806           }
1807         dump_subcommand (sbc);
1808         dump (-1, "}");
1809         outdent ();
1810       }
1811   }
1812
1813
1814   /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1815   dump(1,"else if ( settings_get_syntax () != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
1816   dump(1,"{");
1817
1818   dump (0, "lex_match (lexer, T_EQUALS);");
1819
1820   dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
1821   dump(0,"settings_set_cmd_algorithm (COMPATIBLE);");
1822   outdent();
1823   dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
1824   dump(0,"settings_set_cmd_algorithm (ENHANCED);");
1825
1826   dump (-1, "}");
1827   outdent ();
1828
1829
1830
1831   dump (1, "if (!lex_match (lexer, T_SLASH))");
1832   dump (0, "break;");
1833   dump (-2, "}");
1834   outdent ();
1835   dump_blank_line (0);
1836   dump (1, "if (lex_token (lexer) != T_ENDCMD)");
1837   dump (1, "{");
1838   dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
1839   dump (0, "goto lossage;");
1840   dump (-1, "}");
1841   dump_blank_line (0);
1842
1843   outdent ();
1844
1845   {
1846     /*  Check that mandatory subcommands have been specified  */
1847     subcommand *sbc;
1848
1849     for (sbc = subcommands; sbc; sbc = sbc->next)
1850       {
1851
1852         if ( sbc->arity == ARITY_ONCE_EXACTLY )
1853           {
1854             dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1855             dump (1, "{");
1856             dump (0, "lex_sbc_missing (\"%s\");", sbc->name);
1857             dump (0, "goto lossage;");
1858             dump (-1, "}");
1859             dump_blank_line (0);
1860           }
1861       }
1862   }
1863
1864   dump (-1, "return true;");
1865   dump_blank_line (0);
1866   dump (-1, "lossage:");
1867   indent ();
1868   dump (0, "free_%s (p);", make_identifier (cmdname));
1869   dump (0, "return false;");
1870   dump (-1, "}");
1871   dump_blank_line (0);
1872 }
1873
1874
1875 /* Write the output file header. */
1876 static void
1877 dump_header (void)
1878 {
1879   indent = 0;
1880   dump (0,   "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1881   dump_blank_line (0);
1882   dump (0, "   Generated by q2c from %s.", ifn);
1883   dump (0, "   Do not modify!");
1884   dump (0, " */");
1885 }
1886
1887 /* Write out commands to free variable state. */
1888 static void
1889 dump_free (int persistent)
1890 {
1891   subcommand *sbc;
1892   int used;
1893
1894   indent = 0;
1895
1896   used = 0;
1897   if ( ! persistent )
1898     {
1899       for (sbc = subcommands; sbc; sbc = sbc->next)
1900         used = (sbc->type == SBC_STRING
1901                 || sbc->type == SBC_DBL_LIST
1902                 || sbc->type == SBC_INT_LIST);
1903     }
1904
1905   dump (0, "static void");
1906   dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1907         make_identifier (cmdname), used ? "" : " UNUSED");
1908   dump (1, "{");
1909
1910   if ( ! persistent )
1911     {
1912
1913       for (sbc = subcommands; sbc; sbc = sbc->next)
1914         {
1915           switch (sbc->type)
1916             {
1917             case SBC_VARLIST:
1918               dump (0, "free (p->v_%s);", st_lower (sbc->name));
1919               break;
1920             case SBC_STRING:
1921               dump (0, "free (p->s_%s);", st_lower (sbc->name));
1922               break;
1923             case SBC_DBL_LIST:
1924             case SBC_INT_LIST:
1925               dump (0, "{");
1926               dump (1, "int i;");
1927               dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
1928               dump (1, "subc_list_%s_destroy(&p->%cl_%s[i]);",
1929                     sbc->type == SBC_INT_LIST ? "int" : "double",
1930                     sbc->type == SBC_INT_LIST ? 'i' : 'd',
1931                     st_lower (sbc->name));
1932               dump (0, "}");
1933               outdent();
1934               break;
1935             case SBC_PLAIN:
1936               {
1937                 specifier *spec;
1938                 setting *s;
1939
1940                 for (spec = sbc->spec; spec; spec = spec->next)
1941                   for (s = spec->s; s; s = s->next)
1942                     if (s->value == VAL_STRING)
1943                       dump (0, "free (p->%s%s);",
1944                             sbc->prefix, st_lower (s->valname));
1945               }
1946             default:
1947               break;
1948             }
1949         }
1950     }
1951
1952   dump (-1, "}");
1953
1954 }
1955
1956
1957
1958 /* Returns the name of a directive found on the current input line, if
1959    any, or a null pointer if none found. */
1960 static const char *
1961 recognize_directive (void)
1962 {
1963   static char directive[16];
1964   char *sp, *ep;
1965
1966   sp = skip_ws (buf);
1967   if (strncmp (sp, "/*", 2))
1968     return NULL;
1969   sp = skip_ws (sp + 2);
1970   if (*sp != '(')
1971     return NULL;
1972   sp++;
1973
1974   ep = strchr (sp, ')');
1975   if (ep == NULL)
1976     return NULL;
1977
1978   if (ep - sp > 15)
1979     ep = sp + 15;
1980   memcpy (directive, sp, ep - sp);
1981   directive[ep - sp] = '\0';
1982   return directive;
1983 }
1984
1985 int
1986 main (int argc, char *argv[])
1987 {
1988   program_name = argv[0];
1989   if (argc != 3)
1990     fail ("Syntax: q2c input.q output.c");
1991
1992   ifn = argv[1];
1993   in = fopen (ifn, "r");
1994   if (!in)
1995     fail ("%s: open: %s.", ifn, strerror (errno));
1996
1997   ofn = argv[2];
1998   out = fopen (ofn, "w");
1999   if (!out)
2000     fail ("%s: open: %s.", ofn, strerror (errno));
2001
2002   is_open = true;
2003   buf = xmalloc (MAX_LINE_LEN);
2004   tokstr = xmalloc (MAX_TOK_LEN);
2005
2006   dump_header ();
2007
2008
2009   indent = 0;
2010   dump (0, "#line %d \"%s\"", ln + 1, ifn);
2011   while (get_line ())
2012     {
2013       const char *directive = recognize_directive ();
2014       if (directive == NULL)
2015         {
2016           dump (0, "%s", buf);
2017           continue;
2018         }
2019
2020       dump (0, "#line %d \"%s\"", oln + 1, ofn);
2021       if (!strcmp (directive, "specification"))
2022         {
2023           /* Skip leading slash-star line. */
2024           get_line ();
2025           lex_get ();
2026
2027           parse ();
2028
2029           /* Skip trailing star-slash line. */
2030           get_line ();
2031         }
2032       else if (!strcmp (directive, "headers"))
2033         {
2034           indent = 0;
2035
2036           dump (0, "#include <stdlib.h>");
2037           dump_blank_line (0);
2038
2039           dump (0, "#include \"data/settings.h\"");
2040           dump (0, "#include \"data/variable.h\"");
2041           dump (0, "#include \"language/lexer/lexer.h\"");
2042           dump (0, "#include \"language/lexer/subcommand-list.h\"");
2043           dump (0, "#include \"language/lexer/variable-parser.h\"");
2044           dump (0, "#include \"libpspp/assertion.h\"");
2045           dump (0, "#include \"libpspp/cast.h\"");
2046           dump (0, "#include \"libpspp/message.h\"");
2047           dump (0, "#include \"libpspp/str.h\"");
2048           dump_blank_line (0);
2049
2050           dump (0, "#include \"gl/xalloc.h\"");
2051           dump_blank_line (0);
2052
2053           dump (0, "#include \"gettext.h\"");
2054           dump (0, "#define _(msgid) gettext (msgid)");
2055           dump_blank_line (0);
2056         }
2057       else if (!strcmp (directive, "declarations"))
2058         dump_declarations ();
2059       else if (!strcmp (directive, "functions"))
2060         {
2061           dump_parser (0);
2062           dump_free (0);
2063         }
2064       else if (!strcmp (directive, "_functions"))
2065         {
2066           dump_parser (1);
2067           dump_free (1);
2068         }
2069       else
2070         error ("unknown directive `%s'", directive);
2071       indent = 0;
2072       dump (0, "#line %d \"%s\"", ln + 1, ifn);
2073     }
2074
2075   return EXIT_SUCCESS;
2076 }