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