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

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-9, 2000, 2008, 2010, 2011 Free Software Foundation, Inc.
   3
   4    This program is free software: you can redistribute it and/or modify
   5    it under the terms of the GNU General Public License as published by
   6    the Free Software Foundation, either version 3 of the License, or
   7    (at your option) any later version.
   8
   9    This program is distributed in the hope that it will be useful,
  10    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12    GNU General Public License for more details.
  13
  14    You should have received a copy of the GNU General Public License
  15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  16
  17 #include <assert.h>
  18 #include <ctype.h>
  19 #include <stdio.h>
  20 #include <stdlib.h>
  21 #include <stdarg.h>
  22 #include <stdbool.h>
  23 #include <string.h>
  24 #include <errno.h>
  25 #include <unistd.h>
  26
  27 /* GNU C allows the programmer to declare that certain functions take
  28    printf-like arguments, never return, etc.  Conditionalize these
  29    declarations on whether gcc is in use. */
  30 #if __GNUC__ > 1
  31 #define ATTRIBUTE(X) __attribute__ (X)
  32 #else
  33 #define ATTRIBUTE(X)
  34 #endif
  35
  36 /* Marks a function argument as possibly not used. */
  37 #define UNUSED ATTRIBUTE ((unused))
  38
  39 /* Marks a function that will never return. */
  40 #define NO_RETURN ATTRIBUTE ((noreturn))
  41
  42 /* Mark a function as taking a printf- or scanf-like format
  43    string as its FMT'th argument and that the FIRST'th argument
  44    is the first one to be checked against the format string. */
  45 #define PRINTF_FORMAT(FMT, FIRST) ATTRIBUTE ((format (__printf__, FMT, FIRST)))
  46
  47 /* Max length of an input line. */
  48 #define MAX_LINE_LEN 1024
  49
  50 /* Max token length. */
  51 #define MAX_TOK_LEN 1024
  52
  53 /* argv[0]. */
  54 static char *program_name;
  55
  56 /* Have the input and output files been opened yet? */
  57 static bool is_open;
  58
  59 /* Input, output files. */
  60 static FILE *in, *out;
  61
  62 /* Input, output file names. */
  63 static char *ifn, *ofn;
  64
  65 /* Input, output file line number. */
  66 static int ln, oln = 1;
  67
  68 /* Input line buffer, current position. */
  69 static char *buf, *cp;
  70
  71 /* Token types. */
  72 enum
  73   {
  74     T_STRING = 256,     /* String literal. */
  75     T_ID = 257          /* Identifier.  */
  76   };
  77
  78 /* Current token: either one of the above, or a single character. */
  79 static int token;
  80
  81 /* Token string value. */
  82 static char *tokstr;
  83 \f
  84 /* Utility functions. */
  85
  86 /* Close all open files and delete the output file, on failure. */
  87 static void
  88 finish_up (void)
  89 {
  90   if (!is_open)
  91     return;
  92   is_open = false;
  93   fclose (in);
  94   fclose (out);
  95   if (remove (ofn) == -1)
  96     fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
  97 }
  98
  99 void hcf (void) NO_RETURN;
 100
 101 /* Terminate unsuccessfully. */
 102 void
 103 hcf (void)
 104 {
 105   finish_up ();
 106   exit (EXIT_FAILURE);
 107 }
 108
 109 int fail (const char *, ...) PRINTF_FORMAT (1, 2) NO_RETURN;
 110 int error (const char *, ...) PRINTF_FORMAT (1, 2) NO_RETURN;
 111
 112 /* Output an error message and terminate unsuccessfully. */
 113 int
 114 fail (const char *format, ...)
 115 {
 116   va_list args;
 117
 118   va_start (args, format);
 119   fprintf (stderr, "%s: ", program_name);
 120   vfprintf (stderr, format, args);
 121   fprintf (stderr, "\n");
 122   va_end (args);
 123
 124   hcf ();
 125 }
 126
 127 /* Output a context-dependent error message and terminate
 128    unsuccessfully. */
 129 int
 130 error (const char *format,...)
 131 {
 132   va_list args;
 133
 134   va_start (args, format);
 135   fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
 136   vfprintf (stderr, format, args);
 137   fprintf (stderr, "\n");
 138   va_end (args);
 139
 140   hcf ();
 141 }
 142
 143 #define VME "virtual memory exhausted"
 144
 145 /* Allocate a block of SIZE bytes and return a pointer to its
 146    beginning. */
 147 static void *
 148 xmalloc (size_t size)
 149 {
 150   void *vp;
 151
 152   if (size == 0)
 153     return NULL;
 154
 155   vp = malloc (size);
 156   if (!vp)
 157     fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
 158
 159   return vp;
 160 }
 161
 162 /* Make a dynamically allocated copy of string S and return a pointer
 163    to the first character. */
 164 static char *
 165 xstrdup (const char *s)
 166 {
 167   size_t size;
 168   char *t;
 169
 170   assert (s != NULL);
 171   size = strlen (s) + 1;
 172
 173   t = malloc (size);
 174   if (!t)
 175     fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
 176
 177   memcpy (t, s, size);
 178   return t;
 179 }
 180
 181 /* Returns a pointer to one of 8 static buffers.  The buffers are used
 182    in rotation. */
 183 static char *
 184 get_buffer (void)
 185 {
 186   static char b[8][256];
 187   static int cb;
 188
 189   if (++cb >= 8)
 190     cb = 0;
 191
 192   return b[cb];
 193 }
 194
 195 /* Copies a string to a static buffer, converting it to lowercase in
 196    the process, and returns a pointer to the static buffer. */
 197 static char *
 198 st_lower (const char *s)
 199 {
 200   char *p, *cp;
 201
 202   p = cp = get_buffer ();
 203   while (*s)
 204     *cp++ = tolower ((unsigned char) (*s++));
 205   *cp++ = '\0';
 206
 207   return p;
 208 }
 209
 210 /* Copies a string to a static buffer, converting it to uppercase in
 211    the process, and returns a pointer to the static buffer. */
 212 static char *
 213 st_upper (const char *s)
 214 {
 215   char *p, *cp;
 216
 217   p = cp = get_buffer ();
 218   while (*s)
 219     *cp++ = toupper ((unsigned char) (*s++));
 220   *cp++ = '\0';
 221
 222   return p;
 223 }
 224
 225 /* Returns the address of the first non-whitespace character in S, or
 226    the address of the null terminator if none. */
 227 static char *
 228 skip_ws (char *s)
 229 {
 230   while (isspace ((unsigned char) *s))
 231     s++;
 232   return s;
 233 }
 234
 235 /* Read one line from the input file into buf.  Lines having special
 236    formats are handled specially. */
 237 static bool
 238 get_line (void)
 239 {
 240   ln++;
 241   if (0 == fgets (buf, MAX_LINE_LEN, in))
 242     {
 243       if (ferror (in))
 244         fail ("%s: fgets: %s", ifn, strerror (errno));
 245       return false;
 246     }
 247
 248   cp = strchr (buf, '\n');
 249   if (cp != NULL)
 250     *cp = '\0';
 251
 252   cp = buf;
 253   return true;
 254 }
 255 \f
 256 /* Symbol table manager. */
 257
 258 /* Symbol table entry. */
 259 typedef struct symbol symbol;
 260 struct symbol
 261   {
 262     symbol *next;               /* Next symbol in symbol table. */
 263     char *name;                 /* Symbol name. */
 264     int unique;                 /* 1=Name must be unique in this file. */
 265     int ln;                     /* Line number of definition. */
 266     int value;                  /* Symbol value. */
 267   };
 268
 269 /* Symbol table. */
 270 symbol *symtab;
 271
 272 /* Add a symbol to the symbol table having name NAME, uniqueness
 273    UNIQUE, and value VALUE.  If a symbol having the same name is found
 274    in the symbol table, its sequence number is returned and the symbol
 275    table is not modified.  Otherwise, the symbol is added and the next
 276    available sequence number is returned. */
 277 static int
 278 add_symbol (const char *name, int unique, int value)
 279 {
 280   symbol *iter, *sym;
 281   int x;
 282
 283   sym = xmalloc (sizeof *sym);
 284   sym->name = xstrdup (name);
 285   sym->unique = unique;
 286   sym->value = value;
 287   sym->next = NULL;
 288   sym->ln = ln;
 289   if (!symtab)
 290     {
 291       symtab = sym;
 292       return 1;
 293     }
 294   iter = symtab;
 295   x = 1;
 296   for (;;)
 297     {
 298       if (!strcmp (iter->name, name))
 299         {
 300           if (iter->unique)
 301             {
 302               fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
 303                        ln, name);
 304               fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
 305                        iter->ln);
 306               hcf ();
 307             }
 308           free (sym->name);
 309           free (sym);
 310           return x;
 311         }
 312       if (!iter->next)
 313         break;
 314       iter = iter->next;
 315       x++;
 316     }
 317   iter->next = sym;
 318   return ++x;
 319 }
 320
 321 /* Finds the symbol having given sequence number X within the symbol
 322    table, and returns the associated symbol structure. */
 323 static symbol *
 324 find_symbol (int x)
 325 {
 326   symbol *iter;
 327
 328   iter = symtab;
 329   while (x > 1 && iter)
 330     {
 331       iter = iter->next;
 332       x--;
 333     }
 334   assert (iter);
 335   return iter;
 336 }
 337
 338 #if DUMP_TOKENS
 339 /* Writes a printable representation of the current token to
 340    stdout. */
 341 static void
 342 dump_token (void)
 343 {
 344   switch (token)
 345     {
 346     case T_STRING:
 347       printf ("STRING\t\"%s\"\n", tokstr);
 348       break;
 349     case T_ID:
 350       printf ("ID\t%s\n", tokstr);
 351       break;
 352     default:
 353       printf ("PUNCT\t%c\n", token);
 354     }
 355 }
 356 #endif /* DUMP_TOKENS */
 357
 358
 359 const char hyphen_proxy = '_';
 360
 361 static void
 362 id_cpy (char **cp)
 363 {
 364   char *dest = tokstr;
 365   char *src = *cp;
 366
 367   while (*src == '_' || *src == '-' || isalnum ((unsigned char) *src))
 368     {
 369       *dest++ = *src == '-' ? hyphen_proxy :toupper ((unsigned char) (*src));
 370       src++;
 371     }
 372
 373   *cp = src;
 374   *dest++ = '\0';
 375 }
 376
 377 static char *
 378 unmunge (const char *s)
 379 {
 380   char *dest = xmalloc (strlen (s) + 1);
 381   char *d = dest;
 382
 383   while (*s)
 384     {
 385       if (*s == hyphen_proxy)
 386         *d = '-';
 387       else
 388         *d = *s;
 389       s++;
 390       d++;
 391     }
 392   *d = '\0';
 393
 394   return dest;
 395 }
 396
 397 /* Reads a token from the input file. */
 398 static int
 399 lex_get (void)
 400 {
 401   /* Skip whitespace and check for end of file. */
 402   for (;;)
 403     {
 404       cp = skip_ws (cp);
 405       if (*cp != '\0')
 406         break;
 407
 408       if (!get_line ())
 409         fail ("%s: Unexpected end of file.", ifn);
 410     }
 411
 412   if (*cp == '"')
 413     {
 414       char *dest = tokstr;
 415       token = T_STRING;
 416       cp++;
 417       while (*cp != '"' && *cp)
 418         {
 419           if (*cp == '\\')
 420             {
 421               cp++;
 422               if (!*cp)
 423                 error ("Unterminated string literal.");
 424               *dest++ = *cp++;
 425             }
 426           else
 427             *dest++ = *cp++;
 428         }
 429       *dest++ = 0;
 430       if (!*cp)
 431         error ("Unterminated string literal.");
 432       cp++;
 433     }
 434   else if (*cp == '_' || isalnum ((unsigned char) *cp))
 435     {
 436       char *dest = tokstr;
 437       token = T_ID;
 438
 439       id_cpy (&cp);
 440     }
 441   else
 442     token = *cp++;
 443
 444 #if DUMP_TOKENS
 445   dump_token ();
 446 #endif
 447
 448   return token;
 449 }
 450
 451 /* Force the current token to be an identifier token. */
 452 static void
 453 force_id (void)
 454 {
 455   if (token != T_ID)
 456     error ("Identifier expected.");
 457 }
 458
 459 /* Force the current token to be a string token. */
 460 static void
 461 force_string (void)
 462 {
 463   if (token != T_STRING)
 464     error ("String expected.");
 465 }
 466
 467 /* Checks whether the current token is the identifier S; if so, skips
 468    the token and returns true; otherwise, returns false. */
 469 static bool
 470 match_id (const char *s)
 471 {
 472   if (token == T_ID && !strcmp (tokstr, s))
 473     {
 474       lex_get ();
 475       return true;
 476     }
 477   return false;
 478 }
 479
 480 /* Checks whether the current token is T.  If so, skips the token and
 481    returns true; otherwise, returns false. */
 482 static bool
 483 match_token (int t)
 484 {
 485   if (token == t)
 486     {
 487       lex_get ();
 488       return true;
 489     }
 490   return false;
 491 }
 492
 493 /* Force the current token to be T, and skip it. */
 494 static void
 495 skip_token (int t)
 496 {
 497   if (token != t)
 498     error ("`%c' expected.", t);
 499   lex_get ();
 500 }
 501 \f
 502 /* Structures. */
 503
 504 /* Some specifiers have associated values. */
 505 enum
 506   {
 507     VAL_NONE,   /* No value. */
 508     VAL_INT,    /* Integer value. */
 509     VAL_DBL,    /* Floating point value. */
 510     VAL_STRING  /* String value. */
 511   };
 512
 513 /* For those specifiers with values, the syntax of those values. */
 514 enum
 515   {
 516     VT_PLAIN,   /* Unadorned value. */
 517     VT_PAREN    /* Value must be enclosed in parentheses. */
 518   };
 519
 520 /* Forward definition. */
 521 typedef struct specifier specifier;
 522
 523 /* A single setting. */
 524 typedef struct setting setting;
 525 struct setting
 526   {
 527     specifier *parent;  /* Owning specifier. */
 528     setting *next;      /* Next in the chain. */
 529     char *specname;     /* Name of the setting. */
 530     int con;            /* Sequence number. */
 531
 532     /* Values. */
 533     int valtype;        /* One of VT_*. */
 534     int value;          /* One of VAL_*. */
 535     int optvalue;       /* 1=value is optional, 0=value is required. */
 536     char *valname;      /* Variable name for the value. */
 537     char *restriction;  /* !=NULL: expression specifying valid values. */
 538   };
 539
 540 /* A single specifier. */
 541 struct specifier
 542   {
 543     specifier *next;    /* Next in the chain. */
 544     char *varname;      /* Variable name. */
 545     setting *s;         /* Associated settings. */
 546
 547     setting *def;       /* Default setting. */
 548     setting *omit_kw;   /* Setting for which the keyword can be omitted. */
 549
 550     int index;          /* Next array index. */
 551   };
 552
 553 /* Subcommand types. */
 554 typedef enum
 555   {
 556     SBC_PLAIN,          /* The usual case. */
 557     SBC_VARLIST,        /* Variable list. */
 558     SBC_INT,            /* Integer value. */
 559     SBC_PINT,           /* Integer inside parentheses. */
 560     SBC_DBL,            /* Floating point value. */
 561     SBC_INT_LIST,       /* List of integers (?). */
 562     SBC_DBL_LIST,       /* List of floating points (?). */
 563     SBC_CUSTOM,         /* Custom. */
 564     SBC_ARRAY,          /* Array of boolean values. */
 565     SBC_STRING,         /* String value. */
 566     SBC_VAR             /* Single variable name. */
 567   }
 568 subcommand_type;
 569
 570 typedef enum
 571   {
 572     ARITY_ONCE_EXACTLY,  /* must occur exactly once */
 573     ARITY_ONCE_ONLY,     /* zero or once */
 574     ARITY_MANY           /* 0, 1, ... , inf */
 575   }subcommand_arity;
 576
 577 /* A single subcommand. */
 578 typedef struct subcommand subcommand;
 579 struct subcommand
 580   {
 581     subcommand *next;           /* Next in the chain. */
 582     char *name;                 /* Subcommand name. */
 583     subcommand_type type;       /* One of SBC_*. */
 584     subcommand_arity arity;     /* How many times should the subcommand occur*/
 585     int narray;                 /* Index of next array element. */
 586     const char *prefix;         /* Prefix for variable and constant names. */
 587     specifier *spec;            /* Array of specifiers. */
 588
 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_phrase (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, "lex_error_expecting (lexer, \"`('\", "
1504                         "NULL_SENTINEL);");
1505                   dump (0, "goto lossage;");
1506                   dump (-1, "}");
1507                   outdent ();
1508                 }
1509             }
1510
1511           if (s->value == VAL_INT)
1512             {
1513               dump (1, "if (!lex_force_int (lexer))");
1514               dump (0, "goto lossage;");
1515               dump (-1, "p->%s%s = lex_integer (lexer);",
1516                     sbc->prefix, st_lower (s->valname));
1517             }
1518           else if (s->value == VAL_DBL)
1519             {
1520               dump (1, "if (!lex_force_num (lexer))");
1521               dump (0, "goto lossage;");
1522               dump (-1, "p->%s%s = lex_tokval (lexer);", sbc->prefix,
1523                     st_lower (s->valname));
1524             }
1525           else if (s->value == VAL_STRING)
1526             {
1527               dump (1, "if (lex_token (lexer) != T_ID "
1528                     "&& !lex_is_string (lexer))");
1529               dump (1, "{");
1530               dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1531                     "requires a string argument.\"));",
1532                     s->specname, sbc->name);
1533               dump (0, "goto lossage;");
1534               dump (-1, "}");
1535               dump (-1, "free (p->%s%s);", sbc->prefix, st_lower (s->valname));
1536               dump (0, "p->%s%s = ss_xstrdup (ss_tokss (lexer));",
1537                     sbc->prefix, st_lower (s->valname));
1538             }
1539           else
1540             abort ();
1541
1542           if (s->restriction)
1543             {
1544               {
1545                 char *str, *str2;
1546                 str = xmalloc (MAX_TOK_LEN);
1547                 str2 = xmalloc (MAX_TOK_LEN);
1548                 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1549                 sprintf (str, s->restriction, str2, str2, str2, str2,
1550                          str2, str2, str2, str2);
1551                 dump (1, "if (!(%s))", str);
1552                 free (str);
1553                 free (str2);
1554               }
1555
1556               dump (1, "{");
1557               dump (0, "msg (SE, _(\"Bad argument for %s "
1558                     "specifier of %s subcommand.\"));",
1559                     s->specname, sbc->name);
1560               dump (0, "goto lossage;");
1561               dump (-1, "}");
1562               outdent ();
1563             }
1564
1565           dump (0, "lex_get (lexer);");
1566
1567           if (s->valtype == VT_PAREN)
1568             {
1569               dump (1, "if (!lex_force_match (lexer, T_RPAREN))");
1570               dump (0, "goto lossage;");
1571               outdent ();
1572               if (s->optvalue)
1573                 {
1574                   dump (-1, "}");
1575                   outdent ();
1576                 }
1577             }
1578
1579           if (s != spec->omit_kw)
1580             dump (-1, "}");
1581         }
1582
1583       if (s == spec->omit_kw)
1584         {
1585           dump (-1, "}");
1586           outdent ();
1587         }
1588       outdent ();
1589     }
1590 }
1591
1592 /* Write out the code to parse subcommand SBC. */
1593 static void
1594 dump_subcommand (const subcommand *sbc)
1595 {
1596   if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1597     {
1598       int count;
1599
1600       dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1601       dump (1, "{");
1602
1603       {
1604         specifier *spec;
1605
1606         for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1607           {
1608             if (spec->s)
1609               dump_specifier_parse (spec, sbc);
1610             else
1611               {
1612                 count++;
1613                 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1614                       make_match (st_upper (spec->varname)));
1615                 if (sbc->type == SBC_PLAIN)
1616                   dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1617                         spec->varname);
1618                 else
1619                   dump (0, "p->a_%s[%s%s%s] = 1;",
1620                         st_lower (sbc->name),
1621                         st_upper (prefix), st_upper (sbc->prefix),
1622                         st_upper (spec->varname));
1623                 outdent ();
1624               }
1625           }
1626       }
1627
1628       {
1629         specifier *spec;
1630         setting *s;
1631
1632         /* This code first finds the last specifier in sbc.  Then it
1633            finds the last setting within that last specifier.  Either
1634            or both might be NULL. */
1635         spec = sbc->spec;
1636         s = NULL;
1637         if (spec)
1638           {
1639             while (spec->next)
1640               spec = spec->next;
1641             s = spec->s;
1642             if (s)
1643               while (s->next)
1644                 s = s->next;
1645           }
1646
1647         if (spec && (!spec->s || !spec->omit_kw))
1648           {
1649             dump (1, "else");
1650             dump (1, "{");
1651             dump (0, "lex_error (lexer, NULL);");
1652             dump (0, "goto lossage;");
1653             dump (-1, "}");
1654             outdent ();
1655           }
1656       }
1657
1658       dump (0, "lex_match (lexer, T_COMMA);");
1659       dump (-1, "}");
1660       outdent ();
1661     }
1662   else if (sbc->type == SBC_VARLIST)
1663     {
1664       dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1665             "PV_APPEND%s%s))",
1666             st_lower (sbc->prefix), st_lower (sbc->name),
1667             st_lower (sbc->prefix), st_lower (sbc->name),
1668             sbc->message ? " |" : "",
1669             sbc->message ? sbc->message : "");
1670       dump (0, "goto lossage;");
1671       outdent ();
1672     }
1673   else if (sbc->type == SBC_VAR)
1674     {
1675       dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
1676             st_lower (sbc->prefix), st_lower (sbc->name));
1677       dump (1, "if (!p->%sv_%s)",
1678             st_lower (sbc->prefix), st_lower (sbc->name));
1679       dump (0, "goto lossage;");
1680       outdent ();
1681     }
1682   else if (sbc->type == SBC_STRING)
1683     {
1684       if (sbc->restriction)
1685         {
1686           dump (1, "{");
1687           dump (0, "int x;");
1688         }
1689       dump (1, "if (!lex_force_string (lexer))");
1690       dump (0, "return false;");
1691       outdent ();
1692       if (sbc->restriction)
1693         {
1694           dump (0, "x = ss_length (lex_tokss (lexer));");
1695           dump (1, "if (!(%s))", sbc->restriction);
1696           dump (1, "{");
1697           dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1698                 sbc->name, sbc->message);
1699           dump (0, "goto lossage;");
1700           dump (-1, "}");
1701           outdent ();
1702         }
1703       dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1704       dump (0, "p->s_%s = ss_xstrdup (lex_tokss (lexer));",
1705             st_lower (sbc->name));
1706       dump (0, "lex_get (lexer);");
1707       if (sbc->restriction)
1708         dump (-1, "}");
1709     }
1710   else if (sbc->type == SBC_DBL)
1711     {
1712       dump (1, "if (!lex_force_num (lexer))");
1713       dump (0, "goto lossage;");
1714       dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
1715             st_lower (sbc->name), st_lower (sbc->name) );
1716       dump (0, "lex_get(lexer);");
1717     }
1718   else if (sbc->type == SBC_INT)
1719     {
1720       dump(1, "{");
1721       dump(0, "int x;");
1722       dump (1, "if (!lex_force_int (lexer))");
1723       dump (0, "goto lossage;");
1724       dump (-1, "x = lex_integer (lexer);");
1725       dump (0, "lex_get(lexer);");
1726       if (sbc->restriction)
1727        {
1728           char buf[1024];
1729           dump (1, "if (!(%s))", sbc->restriction);
1730           dump (1, "{");
1731           sprintf(buf,sbc->message,sbc->name);
1732           if ( sbc->translatable )
1733                   dump (0, "msg (SE, gettext(\"%s\"));",buf);
1734           else
1735                   dump (0, "msg (SE, \"%s\");",buf);
1736           dump (0, "goto lossage;");
1737           dump (-1, "}");
1738       }
1739       dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1740       dump (-1,"}");
1741     }
1742   else if (sbc->type == SBC_PINT)
1743     {
1744       dump (0, "lex_match (lexer, T_LPAREN);");
1745       dump (1, "if (!lex_force_int (lexer))");
1746       dump (0, "goto lossage;");
1747       dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
1748       dump (0, "lex_match (lexer, T_RPAREN);");
1749     }
1750   else if (sbc->type == SBC_DBL_LIST || sbc->type == SBC_INT_LIST)
1751     {
1752       dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1753       dump (1, "{");
1754       dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1755       dump (0, "goto lossage;");
1756       dump (-1,"}");
1757
1758       dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1759       dump (1, "{");
1760       dump (0, "lex_match (lexer, T_COMMA);");
1761       dump (0, "if (!lex_force_num (lexer))");
1762       dump (1, "{");
1763       dump (0, "goto lossage;");
1764       dump (-1,"}");
1765
1766       dump (0, "subc_list_%s_push (&p->%cl_%s[p->sbc_%s-1], lex_number (lexer));",
1767             sbc->type == SBC_INT_LIST ? "int" : "double",
1768             sbc->type == SBC_INT_LIST ? 'i' : 'd',
1769             st_lower (sbc->name), st_lower (sbc->name));
1770
1771       dump (0, "lex_get (lexer);");
1772       dump (-1,"}");
1773
1774     }
1775   else if (sbc->type == SBC_CUSTOM)
1776     {
1777       dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1778             st_lower (prefix), st_lower (sbc->name));
1779       dump (0, "{");
1780       dump (1, "case 0:");
1781       dump (0, "goto lossage;");
1782       dump (-1, "case 1:");
1783       indent ();
1784       dump (0, "break;");
1785       dump (-1, "case 2:");
1786       indent ();
1787       dump (0, "lex_error (lexer, NULL);");
1788       dump (0, "goto lossage;");
1789       dump (-1, "default:");
1790       indent ();
1791       dump (0, "NOT_REACHED ();");
1792       dump (-1, "}");
1793       outdent ();
1794     }
1795 }
1796
1797 /* Write out entire parser. */
1798 static void
1799 dump_parser (int persistent)
1800 {
1801   int f;
1802
1803   indent = 0;
1804
1805   dump (0, "static int");
1806   dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
1807         make_identifier (cmdname),
1808         (def && ( def->type == SBC_VARLIST && def->type == SBC_CUSTOM))?"":" UNUSED",
1809         make_identifier (cmdname));
1810   dump (1, "{");
1811
1812   dump_vars_init (persistent);
1813
1814   dump (1, "for (;;)");
1815   dump (1, "{");
1816
1817   f = 0;
1818   if (def && (def->type == SBC_VARLIST))
1819     {
1820       if (def->type == SBC_VARLIST)
1821         dump (1, "if (lex_token (lexer) == T_ID "
1822               "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) != NULL "
1823               "&& lex_next_token (lexer, 1) != T_EQUALS)");
1824       else
1825         {
1826           dump (0, "if ((lex_token (lexer) == T_ID "
1827                 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) "
1828                 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1829           dump (1, "     || token == T_ALL)");
1830         }
1831       dump (1, "{");
1832       dump (0, "p->sbc_%s++;", st_lower (def->name));
1833       dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1834             "PV_APPEND))",
1835             st_lower (def->prefix), st_lower (def->name),
1836             st_lower (def->prefix), st_lower (def->name));
1837       dump (0, "goto lossage;");
1838       dump (-2, "}");
1839       outdent ();
1840       f = 1;
1841     }
1842   else if (def && def->type == SBC_CUSTOM)
1843     {
1844       dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1845             st_lower (prefix), st_lower (def->name));
1846       dump (0, "{");
1847       dump (1, "case 0:");
1848       dump (0, "goto lossage;");
1849       dump (-1, "case 1:");
1850       indent ();
1851       dump (0, "p->sbc_%s++;", st_lower (def->name));
1852       dump (0, "continue;");
1853       dump (-1, "case 2:");
1854       indent ();
1855       dump (0, "break;");
1856       dump (-1, "default:");
1857       indent ();
1858       dump (0, "NOT_REACHED ();");
1859       dump (-1, "}");
1860       outdent ();
1861     }
1862
1863   {
1864     subcommand *sbc;
1865
1866     for (sbc = subcommands; sbc; sbc = sbc->next)
1867       {
1868         dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1869         f = 1;
1870         dump (1, "{");
1871
1872         dump (0, "lex_match (lexer, T_EQUALS);");
1873         dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1874         if (sbc->arity != ARITY_MANY)
1875           {
1876             dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1877             dump (1, "{");
1878             dump (0, "lex_sbc_only_once (\"%s\");", sbc->name);
1879             dump (0, "goto lossage;");
1880             dump (-1, "}");
1881             outdent ();
1882           }
1883         dump_subcommand (sbc);
1884         dump (-1, "}");
1885         outdent ();
1886       }
1887   }
1888
1889
1890   /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1891   dump(1,"else if ( settings_get_syntax () != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
1892   dump(1,"{");
1893
1894   dump (0, "lex_match (lexer, T_EQUALS);");
1895
1896   dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
1897   dump(0,"settings_set_cmd_algorithm (COMPATIBLE);");
1898   outdent();
1899   dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
1900   dump(0,"settings_set_cmd_algorithm (ENHANCED);");
1901
1902   dump (-1, "}");
1903   outdent ();
1904
1905
1906
1907   dump (1, "if (!lex_match (lexer, T_SLASH))");
1908   dump (0, "break;");
1909   dump (-2, "}");
1910   outdent ();
1911   dump_blank_line (0);
1912   dump (1, "if (lex_token (lexer) != T_ENDCMD)");
1913   dump (1, "{");
1914   dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
1915   dump (0, "goto lossage;");
1916   dump (-1, "}");
1917   dump_blank_line (0);
1918
1919   outdent ();
1920
1921   {
1922     /*  Check that mandatory subcommands have been specified  */
1923     subcommand *sbc;
1924
1925     for (sbc = subcommands; sbc; sbc = sbc->next)
1926       {
1927
1928         if ( sbc->arity == ARITY_ONCE_EXACTLY )
1929           {
1930             dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1931             dump (1, "{");
1932             dump (0, "lex_sbc_missing (\"%s\");", sbc->name);
1933             dump (0, "goto lossage;");
1934             dump (-1, "}");
1935             dump_blank_line (0);
1936           }
1937       }
1938   }
1939
1940   dump (-1, "return true;");
1941   dump_blank_line (0);
1942   dump (-1, "lossage:");
1943   indent ();
1944   dump (0, "free_%s (p);", make_identifier (cmdname));
1945   dump (0, "return false;");
1946   dump (-1, "}");
1947   dump_blank_line (0);
1948 }
1949
1950
1951 /* Write the output file header. */
1952 static void
1953 dump_header (void)
1954 {
1955   indent = 0;
1956   dump (0,   "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1957   dump_blank_line (0);
1958   dump (0, "   Generated by q2c from %s.", ifn);
1959   dump (0, "   Do not modify!");
1960   dump (0, " */");
1961 }
1962
1963 /* Write out commands to free variable state. */
1964 static void
1965 dump_free (int persistent)
1966 {
1967   subcommand *sbc;
1968   int used;
1969
1970   indent = 0;
1971
1972   used = 0;
1973   if ( ! persistent )
1974     {
1975       for (sbc = subcommands; sbc; sbc = sbc->next)
1976         used = (sbc->type == SBC_STRING
1977                 || sbc->type == SBC_DBL_LIST
1978                 || sbc->type == SBC_INT_LIST);
1979     }
1980
1981   dump (0, "static void");
1982   dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1983         make_identifier (cmdname), used ? "" : " UNUSED");
1984   dump (1, "{");
1985
1986   if ( ! persistent )
1987     {
1988
1989       for (sbc = subcommands; sbc; sbc = sbc->next)
1990         {
1991           switch (sbc->type)
1992             {
1993             case SBC_VARLIST:
1994               dump (0, "free (p->v_%s);", st_lower (sbc->name));
1995               break;
1996             case SBC_STRING:
1997               dump (0, "free (p->s_%s);", st_lower (sbc->name));
1998               break;
1999             case SBC_DBL_LIST:
2000             case SBC_INT_LIST:
2001               dump (0, "{");
2002               dump (1, "int i;");
2003               dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
2004               dump (1, "subc_list_%s_destroy(&p->%cl_%s[i]);",
2005                     sbc->type == SBC_INT_LIST ? "int" : "double",
2006                     sbc->type == SBC_INT_LIST ? 'i' : 'd',
2007                     st_lower (sbc->name));
2008               dump (0, "}");
2009               outdent();
2010               break;
2011             case SBC_PLAIN:
2012               {
2013                 specifier *spec;
2014                 setting *s;
2015
2016                 for (spec = sbc->spec; spec; spec = spec->next)
2017                   for (s = spec->s; s; s = s->next)
2018                     if (s->value == VAL_STRING)
2019                       dump (0, "free (p->%s%s);",
2020                             sbc->prefix, st_lower (s->valname));
2021               }
2022             default:
2023               break;
2024             }
2025         }
2026     }
2027
2028   dump (-1, "}");
2029
2030 }
2031
2032
2033
2034 /* Returns the name of a directive found on the current input line, if
2035    any, or a null pointer if none found. */
2036 static const char *
2037 recognize_directive (void)
2038 {
2039   static char directive[16];
2040   char *sp, *ep;
2041
2042   sp = skip_ws (buf);
2043   if (strncmp (sp, "/*", 2))
2044     return NULL;
2045   sp = skip_ws (sp + 2);
2046   if (*sp != '(')
2047     return NULL;
2048   sp++;
2049
2050   ep = strchr (sp, ')');
2051   if (ep == NULL)
2052     return NULL;
2053
2054   if (ep - sp > 15)
2055     ep = sp + 15;
2056   memcpy (directive, sp, ep - sp);
2057   directive[ep - sp] = '\0';
2058   return directive;
2059 }
2060
2061 int
2062 main (int argc, char *argv[])
2063 {
2064   program_name = argv[0];
2065   if (argc != 3)
2066     fail ("Syntax: q2c input.q output.c");
2067
2068   ifn = argv[1];
2069   in = fopen (ifn, "r");
2070   if (!in)
2071     fail ("%s: open: %s.", ifn, strerror (errno));
2072
2073   ofn = argv[2];
2074   out = fopen (ofn, "w");
2075   if (!out)
2076     fail ("%s: open: %s.", ofn, strerror (errno));
2077
2078   is_open = true;
2079   buf = xmalloc (MAX_LINE_LEN);
2080   tokstr = xmalloc (MAX_TOK_LEN);
2081
2082   dump_header ();
2083
2084
2085   indent = 0;
2086   dump (0, "#line %d \"%s\"", ln + 1, ifn);
2087   while (get_line ())
2088     {
2089       const char *directive = recognize_directive ();
2090       if (directive == NULL)
2091         {
2092           dump (0, "%s", buf);
2093           continue;
2094         }
2095
2096       dump (0, "#line %d \"%s\"", oln + 1, ofn);
2097       if (!strcmp (directive, "specification"))
2098         {
2099           /* Skip leading slash-star line. */
2100           get_line ();
2101           lex_get ();
2102
2103           parse ();
2104
2105           /* Skip trailing star-slash line. */
2106           get_line ();
2107         }
2108       else if (!strcmp (directive, "headers"))
2109         {
2110           indent = 0;
2111
2112           dump (0, "#include <stdlib.h>");
2113           dump_blank_line (0);
2114
2115           dump (0, "#include \"data/settings.h\"");
2116           dump (0, "#include \"data/variable.h\"");
2117           dump (0, "#include \"language/lexer/lexer.h\"");
2118           dump (0, "#include \"language/lexer/subcommand-list.h\"");
2119           dump (0, "#include \"language/lexer/variable-parser.h\"");
2120           dump (0, "#include \"libpspp/assertion.h\"");
2121           dump (0, "#include \"libpspp/message.h\"");
2122           dump (0, "#include \"libpspp/str.h\"");
2123           dump_blank_line (0);
2124
2125           dump (0, "#include \"gl/xalloc.h\"");
2126           dump_blank_line (0);
2127
2128           dump (0, "#include \"gettext.h\"");
2129           dump (0, "#define _(msgid) gettext (msgid)");
2130           dump_blank_line (0);
2131         }
2132       else if (!strcmp (directive, "declarations"))
2133         dump_declarations ();
2134       else if (!strcmp (directive, "functions"))
2135         {
2136           dump_parser (0);
2137           dump_free (0);
2138         }
2139       else if (!strcmp (directive, "_functions"))
2140         {
2141           dump_parser (1);
2142           dump_free (1);
2143         }
2144       else
2145         error ("unknown directive `%s'", directive);
2146       indent = 0;
2147       dump (0, "#line %d \"%s\"", ln + 1, ifn);
2148     }
2149
2150   return EXIT_SUCCESS;
2151 }