src/language/lexer/q2c.c

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