src/language/lexer/q2c.c

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