src/language/lexer/q2c.c

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