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