src/language/lexer/q2c.c

   1 /* q2c - parser generator for PSPP procedures.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18    02110-1301, USA. */
  19
  20 #include <config.h>
  21
  22 #include <assert.h>
  23 #include <ctype.h>
  24 #include <stdio.h>
  25 #include <stdlib.h>
  26 #include <stdarg.h>
  27 #include <time.h>
  28 #include <errno.h>
  29 #include <unistd.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 char *program_name;
  43
  44 /* Have the input and output files been opened yet? */
  45 int is_open;
  46
  47 /* Input, output files. */
  48 FILE *in, *out;
  49
  50 /* Input, output file names. */
  51 char *ifn, *ofn;
  52
  53 /* Input, output file line number. */
  54 int ln, oln = 1;
  55
  56 /* Input line buffer, current position. */
  57 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 int token;
  68
  69 /* Token string value. */
  70 char *tokstr;
  71 \f
  72 /* Utility functions. */
  73
  74 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 = 0;
  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 int
 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 0;
 236     }
 237
 238   cp = strchr (buf, '\n');
 239   if (cp != NULL)
 240     *cp = '\0';
 241
 242   cp = buf;
 243   return 1;
 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 1; otherwise, returns 0. */
 421 static int
 422 match_id (const char *s)
 423 {
 424   if (token == T_ID && !strcmp (tokstr, s))
 425     {
 426       lex_get ();
 427       return 1;
 428     }
 429   return 0;
 430 }
 431
 432 /* Checks whether the current token is T.  If so, skips the token and
 433    returns 1; otherwise, returns 0. */
 434 static int
 435 match_token (int t)
 436 {
 437   if (token == t)
 438     {
 439       lex_get ();
 440       return 1;
 441     }
 442   return 0;
 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   sbc->arity = ARITY_MANY;
 743
 744   if (match_token ('*'))
 745     {
 746       if (def)
 747         error ("Multiple default subcommands.");
 748       def = sbc;
 749     }
 750
 751   if ( match_token('+'))
 752     sbc->arity = ARITY_ONCE_ONLY ;
 753   else if (match_token('^'))
 754     sbc->arity = ARITY_ONCE_EXACTLY ;
 755
 756
 757   force_id ();
 758   sbc->name = xstrdup (tokstr);
 759   lex_get ();
 760
 761   sbc->narray = 0;
 762   sbc->type = SBC_PLAIN;
 763   sbc->spec = NULL;
 764   sbc->translatable = 0;
 765
 766   if (match_token ('['))
 767     {
 768       force_id ();
 769       sbc->prefix = xstrdup (st_lower (tokstr));
 770       lex_get ();
 771
 772       skip_token (']');
 773       skip_token ('=');
 774
 775       sbc->type = SBC_ARRAY;
 776       parse_specifiers (sbc);
 777
 778     }
 779   else
 780     {
 781       if (match_token ('('))
 782         {
 783           force_id ();
 784           sbc->prefix = xstrdup (st_lower (tokstr));
 785           lex_get ();
 786
 787           skip_token (')');
 788         }
 789       else
 790         sbc->prefix = "";
 791
 792       skip_token ('=');
 793
 794       if (match_id ("VAR"))
 795         sbc->type = SBC_VAR;
 796       if (match_id ("VARLIST"))
 797         {
 798           if (match_token ('('))
 799             {
 800               force_string ();
 801               sbc->message = xstrdup (tokstr);
 802               lex_get();
 803
 804               skip_token (')');
 805             }
 806           else sbc->message = NULL;
 807
 808           sbc->type = SBC_VARLIST;
 809         }
 810       else if (match_id ("INTEGER"))
 811        {
 812         sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
 813         if ( token == T_STRING)
 814          {
 815               sbc->restriction = xstrdup (tokstr);
 816               lex_get ();
 817               if ( match_id("N_") )
 818                {
 819                 skip_token('(');
 820                 force_string ();
 821                 lex_get();
 822                 skip_token(')');
 823                 sbc->translatable = 1;
 824                }
 825               else {
 826                 force_string ();
 827                 lex_get ();
 828               }
 829               sbc->message = xstrdup (tokstr);
 830          }
 831         else
 832             sbc->restriction = NULL;
 833        }
 834       else if (match_id ("PINT"))
 835         sbc->type = SBC_PINT;
 836       else if (match_id ("DOUBLE"))
 837         {
 838           if ( match_id ("LIST") )
 839             sbc->type = SBC_DBL_LIST;
 840           else
 841             sbc->type = SBC_DBL;
 842         }
 843       else if (match_id ("STRING"))
 844         {
 845           sbc->type = SBC_STRING;
 846           if (token == T_STRING)
 847             {
 848               sbc->restriction = xstrdup (tokstr);
 849               lex_get ();
 850               force_string ();
 851               sbc->message = xstrdup (tokstr);
 852               lex_get ();
 853             }
 854           else
 855             sbc->restriction = NULL;
 856         }
 857       else if (match_id ("CUSTOM"))
 858         sbc->type = SBC_CUSTOM;
 859       else
 860         parse_specifiers (sbc);
 861     }
 862 }
 863
 864 /* Parse all the subcommands. */
 865 void
 866 parse_subcommands (void)
 867 {
 868   subcommand **sbc = &subcommands;
 869
 870   for (;;)
 871     {
 872       *sbc = xmalloc (sizeof **sbc);
 873       (*sbc)->next = NULL;
 874
 875       parse_subcommand (*sbc);
 876
 877       if (token == '.')
 878         return;
 879
 880       skip_token (';');
 881       sbc = &(*sbc)->next;
 882     }
 883 }
 884 \f
 885 /* Output. */
 886
 887 #define BASE_INDENT 2           /* Starting indent. */
 888 #define INC_INDENT 2            /* Indent increment. */
 889
 890 /* Increment the indent. */
 891 #define indent() indent += INC_INDENT
 892 #define outdent() indent -= INC_INDENT
 893
 894 /* Size of the indent from the left margin. */
 895 int indent;
 896
 897 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
 898
 899 /* Write line FORMAT to the output file, formatted as with printf,
 900    indented `indent' characters from the left margin.  If INDENTION is
 901    greater than 0, indents BASE_INDENT * INDENTION characters after
 902    writing the line; if INDENTION is less than 0, dedents BASE_INDENT
 903    * INDENTION characters _before_ writing the line. */
 904 void
 905 dump (int indention, const char *format, ...)
 906 {
 907   va_list args;
 908   int i;
 909
 910   if (indention < 0)
 911     indent += BASE_INDENT * indention;
 912
 913   oln++;
 914   va_start (args, format);
 915   for (i = 0; i < indent; i++)
 916     putc (' ', out);
 917   vfprintf (out, format, args);
 918   putc ('\n', out);
 919   va_end (args);
 920
 921   if (indention > 0)
 922     indent += BASE_INDENT * indention;
 923 }
 924
 925 /* Write the structure members for specifier SPEC to the output file.
 926    SBC is the including subcommand. */
 927 static void
 928 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
 929 {
 930   if (spec->varname)
 931     dump (0, "long %s%s;", sbc->prefix, spec->varname);
 932
 933   {
 934     setting *s;
 935
 936     for (s = spec->s; s; s = s->next)
 937       {
 938         if (s->value != VAL_NONE)
 939           {
 940             const char *typename;
 941
 942             assert (s->value == VAL_INT || s->value == VAL_DBL);
 943             typename = s->value == VAL_INT ? "long" : "double";
 944
 945             dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
 946           }
 947       }
 948   }
 949 }
 950
 951 /* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
 952 static int
 953 is_keyword (const char *t)
 954 {
 955   static const char *kw[] =
 956     {
 957       "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
 958       "NE", "ALL", "BY", "TO", "WITH", 0,
 959     };
 960   const char **cp;
 961
 962   for (cp = kw; *cp; cp++)
 963     if (!strcmp (t, *cp))
 964       return 1;
 965   return 0;
 966 }
 967
 968 /* Transforms a string NAME into a valid C identifier: makes
 969    everything lowercase and maps nonalphabetic characters to
 970    underscores.  Returns a pointer to a static buffer. */
 971 static char *
 972 make_identifier (const char *name)
 973 {
 974   char *p = get_buffer ();
 975   char *cp;
 976
 977   for (cp = p; *name; name++)
 978     if (isalpha ((unsigned char) *name))
 979       *cp++ = tolower ((unsigned char) (*name));
 980     else
 981       *cp++ = '_';
 982   *cp = '\0';
 983
 984   return p;
 985 }
 986
 987 /* Writes the struct and enum declarations for the parser. */
 988 static void
 989 dump_declarations (void)
 990 {
 991   indent = 0;
 992
 993   /* Write out enums for all the identifiers in the symbol table. */
 994   {
 995     int f, k;
 996     symbol *sym;
 997     char *buf = NULL;
 998
 999     /* Note the squirmings necessary to make sure that the last enum
1000        is not followed by a comma, as mandated by ANSI C89. */
1001     for (sym = symtab, f = k = 0; sym; sym = sym->next)
1002       if (!sym->unique && !is_keyword (sym->name))
1003         {
1004           if (!f)
1005             {
1006               dump (0, "/* Settings for subcommand specifiers. */");
1007               dump (1, "enum");
1008               dump (1, "{");
1009               f = 1;
1010             }
1011
1012           if (buf == NULL)
1013             buf = xmalloc (1024);
1014           else
1015             dump (0, buf);
1016
1017           if (k)
1018             sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1019           else
1020             {
1021               k = 1;
1022               sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1023             }
1024         }
1025     if (buf)
1026       {
1027         buf[strlen (buf) - 1] = 0;
1028         dump (0, buf);
1029         free (buf);
1030       }
1031     if (f)
1032       {
1033         dump (-1, "};");
1034         dump (-1, nullstr);
1035       }
1036   }
1037
1038   /* Write out some type definitions */
1039   {
1040     dump (0, "#define MAXLISTS 10");
1041   }
1042
1043
1044   /* For every array subcommand, write out the associated enumerated
1045      values. */
1046   {
1047     subcommand *sbc;
1048
1049     for (sbc = subcommands; sbc; sbc = sbc->next)
1050       if (sbc->type == SBC_ARRAY && sbc->narray)
1051         {
1052           dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1053
1054           dump (1, "enum");
1055           dump (1, "{");
1056
1057           {
1058             specifier *spec;
1059
1060             for (spec = sbc->spec; spec; spec = spec->next)
1061                 dump (0, "%s%s%s = %d,",
1062                       st_upper (prefix), st_upper (sbc->prefix),
1063                       st_upper (spec->varname), spec->index);
1064
1065             dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1066
1067             dump (-1, "};");
1068             dump (-1, nullstr);
1069           }
1070         }
1071   }
1072
1073   /* Write out structure declaration. */
1074   {
1075     subcommand *sbc;
1076
1077     dump (0, "/* %s structure. */", cmdname);
1078     dump (1, "struct cmd_%s", make_identifier (cmdname));
1079     dump (1, "{");
1080     for (sbc = subcommands; sbc; sbc = sbc->next)
1081       {
1082         int f = 0;
1083
1084         if (sbc != subcommands)
1085           dump (0, nullstr);
1086
1087         dump (0, "/* %s subcommand. */", sbc->name);
1088         dump (0, "int sbc_%s;", st_lower (sbc->name));
1089
1090         switch (sbc->type)
1091           {
1092           case SBC_ARRAY:
1093           case SBC_PLAIN:
1094             {
1095               specifier *spec;
1096
1097               for (spec = sbc->spec; spec; spec = spec->next)
1098                 {
1099                   if (spec->s == 0)
1100                     {
1101                       if (sbc->type == SBC_PLAIN)
1102                         dump (0, "long int %s%s;", st_lower (sbc->prefix),
1103                               spec->varname);
1104                       else if (f == 0)
1105                         {
1106                           dump (0, "int a_%s[%s%scount];",
1107                                 st_lower (sbc->name),
1108                                 st_upper (prefix),
1109                                 st_upper (sbc->prefix)
1110                                 );
1111
1112                           f = 1;
1113                         }
1114                     }
1115                   else
1116                     dump_specifier_vars (spec, sbc);
1117                 }
1118             }
1119             break;
1120
1121           case SBC_VARLIST:
1122             dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1123                   st_lower (sbc->name));
1124             dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
1125                   st_lower (sbc->name));
1126             break;
1127
1128           case SBC_VAR:
1129             dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
1130                   st_lower (sbc->name));
1131             break;
1132
1133           case SBC_STRING:
1134             dump (0, "char *s_%s;", st_lower (sbc->name));
1135             break;
1136
1137           case SBC_INT:
1138           case SBC_PINT:
1139             dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1140             break;
1141
1142           case SBC_DBL:
1143             dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1144             break;
1145
1146           case SBC_DBL_LIST:
1147             dump (0, "subc_list_double dl_%s[MAXLISTS];",
1148                   st_lower(sbc->name));
1149             break;
1150
1151           case SBC_INT_LIST:
1152             dump (0, "subc_list_int il_%s[MAXLISTS];",
1153                   st_lower(sbc->name));
1154             break;
1155
1156
1157           default:;
1158             /* nothing */
1159           }
1160       }
1161
1162     dump (-1, "};");
1163     dump (-1, nullstr);
1164   }
1165
1166   /* Write out prototypes for custom_*() functions as necessary. */
1167   {
1168     int seen = 0;
1169     subcommand *sbc;
1170
1171     for (sbc = subcommands; sbc; sbc = sbc->next)
1172       if (sbc->type == SBC_CUSTOM)
1173         {
1174           if (!seen)
1175             {
1176               seen = 1;
1177               dump (0, "/* Prototype for custom subcommands of %s. */",
1178                     cmdname);
1179             }
1180           dump (0, "static int %scustom_%s (struct cmd_%s *);",
1181                 st_lower (prefix), st_lower (sbc->name),
1182                 make_identifier (cmdname));
1183         }
1184
1185     if (seen)
1186       dump (0, nullstr);
1187   }
1188
1189   /* Prototypes for parsing and freeing functions. */
1190   {
1191     dump (0, "/* Command parsing functions. */");
1192     dump (0, "static int parse_%s (struct cmd_%s *);",
1193           make_identifier (cmdname), make_identifier (cmdname));
1194     dump (0, "static void free_%s (struct cmd_%s *);",
1195           make_identifier (cmdname), make_identifier (cmdname));
1196     dump (0, nullstr);
1197   }
1198 }
1199
1200 /* Writes out code to initialize all the variables that need
1201    initialization for particular specifier SPEC inside subcommand SBC. */
1202 static void
1203 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1204 {
1205   if (spec->varname)
1206     {
1207       char s[256];
1208
1209       if (spec->def)
1210         sprintf (s, "%s%s",
1211                  st_upper (prefix), find_symbol (spec->def->con)->name);
1212       else
1213         strcpy (s, "-1");
1214       dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1215     }
1216
1217   {
1218     setting *s;
1219
1220     for (s = spec->s; s; s = s->next)
1221       {
1222         if (s->value != VAL_NONE)
1223           {
1224             const char *init;
1225
1226             assert (s->value == VAL_INT || s->value == VAL_DBL);
1227             init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
1228
1229             dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1230           }
1231       }
1232   }
1233 }
1234
1235 /* Write code to initialize all variables. */
1236 static void
1237 dump_vars_init (int persistent)
1238 {
1239   /* Loop through all the subcommands. */
1240   {
1241     subcommand *sbc;
1242
1243     for (sbc = subcommands; sbc; sbc = sbc->next)
1244       {
1245         int f = 0;
1246
1247         dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1248         if ( ! persistent )
1249           {
1250             switch (sbc->type)
1251               {
1252               case SBC_INT_LIST:
1253                 break;
1254
1255               case SBC_DBL_LIST:
1256                 dump (1, "{");
1257                 dump (0, "int i;");
1258                 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1259                 dump (0, "subc_list_double_create(&p->dl_%s[i]) ;",
1260                       st_lower (sbc->name)
1261                       );
1262                 dump (-2, "}");
1263                 break;
1264
1265               case SBC_DBL:
1266                 dump (1, "{");
1267                 dump (0, "int i;");
1268                 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1269                 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1270                 dump (-2, "}");
1271                 break;
1272
1273               case SBC_CUSTOM:
1274                 /* nothing */
1275                 break;
1276
1277               case SBC_PLAIN:
1278               case SBC_ARRAY:
1279                 {
1280                   specifier *spec;
1281
1282                   for (spec = sbc->spec; spec; spec = spec->next)
1283                     if (spec->s == NULL)
1284                       {
1285                         if (sbc->type == SBC_PLAIN)
1286                           dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1287                         else if (f == 0)
1288                           {
1289                             dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1290                                   st_lower (sbc->name), st_lower (sbc->name));
1291                             f = 1;
1292                           }
1293                       }
1294                     else
1295                       dump_specifier_init (spec, sbc);
1296                 }
1297                 break;
1298
1299               case SBC_VARLIST:
1300                 dump (0, "p->%sn_%s = 0;",
1301                       st_lower (sbc->prefix), st_lower (sbc->name));
1302                 dump (0, "p->%sv_%s = NULL;",
1303                       st_lower (sbc->prefix), st_lower (sbc->name));
1304                 break;
1305
1306               case SBC_VAR:
1307                 dump (0, "p->%sv_%s = NULL;",
1308                       st_lower (sbc->prefix), st_lower (sbc->name));
1309                 break;
1310
1311               case SBC_STRING:
1312                 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1313                 break;
1314
1315               case SBC_INT:
1316               case SBC_PINT:
1317                 dump (1, "{");
1318                 dump (0, "int i;");
1319                 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1320                 dump (0, "p->n_%s[i] = NOT_LONG;", st_lower (sbc->name));
1321                 dump (-2, "}");
1322                 break;
1323
1324               default:
1325                 assert (0);
1326               }
1327           }
1328       }
1329   }
1330 }
1331
1332 /* Return a pointer to a static buffer containing an expression that
1333    will match token T. */
1334 static char *
1335 make_match (const char *t)
1336 {
1337   char *s;
1338
1339   s = get_buffer ();
1340
1341   while (*t == '_')
1342     t++;
1343
1344   if (is_keyword (t))
1345     sprintf (s, "lex_match (T_%s)", t);
1346   else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1347     strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
1348             "|| lex_match_id (\"TRUE\"))");
1349   else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1350     strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
1351             "|| lex_match_id (\"FALSE\"))");
1352   else if (isdigit ((unsigned char) t[0]))
1353     sprintf (s, "lex_match_int (%s)", t);
1354   else
1355     sprintf (s, "lex_match_id (\"%s\")", t);
1356
1357   return s;
1358 }
1359
1360 /* Write out the parsing code for specifier SPEC within subcommand
1361    SBC. */
1362 static void
1363 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1364 {
1365   setting *s;
1366
1367   if (spec->omit_kw && spec->omit_kw->next)
1368     error ("Omittable setting is not last setting in `%s' specifier.",
1369            spec->varname);
1370   if (spec->omit_kw && spec->omit_kw->parent->next)
1371     error ("Default specifier is not in last specifier in `%s' "
1372            "subcommand.", sbc->name);
1373
1374   for (s = spec->s; s; s = s->next)
1375     {
1376       int first = spec == sbc->spec && s == spec->s;
1377
1378       /* Match the setting's keyword. */
1379       if (spec->omit_kw == s)
1380         {
1381           if (!first)
1382             {
1383               dump (1, "else");
1384               dump (1, "{");
1385             }
1386           dump (1, "%s;", make_match (s->specname));
1387         }
1388       else
1389         dump (1, "%sif (%s)", first ? "" : "else ",
1390               make_match (s->specname));
1391
1392
1393       /* Handle values. */
1394       if (s->value == VAL_NONE)
1395         dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1396               st_upper (prefix), find_symbol (s->con)->name);
1397       else
1398         {
1399           if (spec->omit_kw != s)
1400             dump (1, "{");
1401
1402           if (spec->varname)
1403             {
1404               dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1405                     st_upper (prefix), find_symbol (s->con)->name);
1406
1407               if ( sbc->type == SBC_ARRAY )
1408                 dump (0, "p->a_%s[%s%s%s] = 1;",
1409                       st_lower (sbc->name),
1410                       st_upper (prefix), st_upper (sbc->prefix),
1411                       st_upper (spec->varname));
1412             }
1413
1414
1415           if (s->valtype == VT_PAREN)
1416             {
1417               if (s->optvalue)
1418                 {
1419                   dump (1, "if (lex_match ('('))");
1420                   dump (1, "{");
1421                 }
1422               else
1423                 {
1424                   dump (1, "if (!lex_match ('('))");
1425                   dump (1, "{");
1426                   dump (0, "msg (SE, _(\"`(' expected after %s "
1427                         "specifier of %s subcommand.\"));",
1428                         s->specname, sbc->name);
1429                   dump (0, "goto lossage;");
1430                   dump (-1, "}");
1431                   outdent ();
1432                 }
1433             }
1434
1435           if (s->value == VAL_INT)
1436             {
1437               dump (1, "if (!lex_is_integer ())");
1438               dump (1, "{");
1439               dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1440                     "requires an integer argument.\"));",
1441                     s->specname, sbc->name);
1442               dump (0, "goto lossage;");
1443               dump (-1, "}");
1444               dump (-1, "p->%s%s = lex_integer ();",
1445                     sbc->prefix, st_lower (s->valname));
1446             }
1447           else
1448             {
1449               dump (1, "if (!lex_is_number ())");
1450               dump (1, "{");
1451               dump (0, "msg (SE, _(\"Number expected after %s "
1452                     "specifier of %s subcommand.\"));",
1453                     s->specname, sbc->name);
1454               dump (0, "goto lossage;");
1455               dump (-1, "}");
1456               dump (-1, "p->%s%s = tokval;", sbc->prefix,
1457                     st_lower (s->valname));
1458             }
1459
1460           if (s->restriction)
1461             {
1462               {
1463                 char *str, *str2;
1464                 str = xmalloc (MAX_TOK_LEN);
1465                 str2 = xmalloc (MAX_TOK_LEN);
1466                 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1467                 sprintf (str, s->restriction, str2, str2, str2, str2,
1468                          str2, str2, str2, str2);
1469                 dump (1, "if (!(%s))", str);
1470                 free (str);
1471                 free (str2);
1472               }
1473
1474               dump (1, "{");
1475               dump (0, "msg (SE, _(\"Bad argument for %s "
1476                     "specifier of %s subcommand.\"));",
1477                     s->specname, sbc->name);
1478               dump (0, "goto lossage;");
1479               dump (-1, "}");
1480               outdent ();
1481             }
1482
1483           dump (0, "lex_get ();");
1484
1485           if (s->valtype == VT_PAREN)
1486             {
1487               dump (1, "if (!lex_match (')'))");
1488               dump (1, "{");
1489               dump (0, "msg (SE, _(\"`)' expected after argument for "
1490                     "%s specifier of %s.\"));",
1491                     s->specname, sbc->name);
1492               dump (0, "goto lossage;");
1493               dump (-1, "}");
1494               outdent ();
1495               if (s->optvalue)
1496                 {
1497                   dump (-1, "}");
1498                   outdent ();
1499                 }
1500             }
1501
1502           if (s != spec->omit_kw)
1503             dump (-1, "}");
1504         }
1505
1506       if (s == spec->omit_kw)
1507         {
1508           dump (-1, "}");
1509           outdent ();
1510         }
1511       outdent ();
1512     }
1513 }
1514
1515 /* Write out the code to parse subcommand SBC. */
1516 static void
1517 dump_subcommand (const subcommand *sbc)
1518 {
1519   if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1520     {
1521       int count;
1522
1523       dump (1, "while (token != '/' && token != '.')");
1524       dump (1, "{");
1525
1526       {
1527         specifier *spec;
1528
1529         for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1530           {
1531             if (spec->s)
1532               dump_specifier_parse (spec, sbc);
1533             else
1534               {
1535                 count++;
1536                 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1537                       make_match (st_upper (spec->varname)));
1538                 if (sbc->type == SBC_PLAIN)
1539                   dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1540                         spec->varname);
1541                 else
1542                   dump (0, "p->a_%s[%s%s%s] = 1;",
1543                         st_lower (sbc->name),
1544                         st_upper (prefix), st_upper (sbc->prefix),
1545                         st_upper (spec->varname));
1546                 outdent ();
1547               }
1548           }
1549       }
1550
1551       {
1552         specifier *spec;
1553         setting *s;
1554
1555         /* This code first finds the last specifier in sbc.  Then it
1556            finds the last setting within that last specifier.  Either
1557            or both might be NULL. */
1558         spec = sbc->spec;
1559         s = NULL;
1560         if (spec)
1561           {
1562             while (spec->next)
1563               spec = spec->next;
1564             s = spec->s;
1565             if (s)
1566               while (s->next)
1567                 s = s->next;
1568           }
1569
1570         if (spec && (!spec->s || !spec->omit_kw))
1571           {
1572             dump (1, "else");
1573             dump (1, "{");
1574             dump (0, "lex_error (NULL);");
1575             dump (0, "goto lossage;");
1576             dump (-1, "}");
1577             outdent ();
1578           }
1579       }
1580
1581       dump (0, "lex_match (',');");
1582       dump (-1, "}");
1583       outdent ();
1584     }
1585   else if (sbc->type == SBC_VARLIST)
1586     {
1587       dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1588             "PV_APPEND%s%s))",
1589             st_lower (sbc->prefix), st_lower (sbc->name),
1590             st_lower (sbc->prefix), st_lower (sbc->name),
1591             sbc->message ? " |" : "",
1592             sbc->message ? sbc->message : "");
1593       dump (0, "goto lossage;");
1594       outdent ();
1595     }
1596   else if (sbc->type == SBC_VAR)
1597     {
1598       dump (0, "p->%sv_%s = parse_variable ();",
1599             st_lower (sbc->prefix), st_lower (sbc->name));
1600       dump (1, "if (!p->%sv_%s)",
1601             st_lower (sbc->prefix), st_lower (sbc->name));
1602       dump (0, "goto lossage;");
1603       outdent ();
1604     }
1605   else if (sbc->type == SBC_STRING)
1606     {
1607       if (sbc->restriction)
1608         {
1609           dump (1, "{");
1610           dump (0, "int x;");
1611         }
1612       dump (1, "if (!lex_force_string ())");
1613       dump (0, "return 0;");
1614       outdent ();
1615       if (sbc->restriction)
1616         {
1617           dump (0, "x = ds_length (&tokstr);");
1618           dump (1, "if (!(%s))", sbc->restriction);
1619           dump (1, "{");
1620           dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1621                 sbc->name, sbc->message);
1622           dump (0, "goto lossage;");
1623           dump (-1, "}");
1624           outdent ();
1625         }
1626       dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1627       dump (0, "p->s_%s = ds_xstrdup (&tokstr);",
1628             st_lower (sbc->name));
1629       dump (0, "lex_get ();");
1630       if (sbc->restriction)
1631         dump (-1, "}");
1632     }
1633   else if (sbc->type == SBC_DBL)
1634     {
1635       dump (1, "if (!lex_force_num ())");
1636       dump (0, "goto lossage;");
1637       dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();",
1638             st_lower (sbc->name), st_lower (sbc->name) );
1639       dump (0, "lex_get();");
1640     }
1641   else if (sbc->type == SBC_INT)
1642     {
1643       dump(1, "{");
1644       dump(0, "int x;");
1645       dump (1, "if (!lex_force_int ())");
1646       dump (0, "goto lossage;");
1647       dump (-1, "x = lex_integer ();");
1648       dump (0, "lex_get();");
1649       if (sbc->restriction)
1650        {
1651           char buf[1024];
1652           dump (1, "if (!(%s))", sbc->restriction);
1653           dump (1, "{");
1654           sprintf(buf,sbc->message,sbc->name);
1655           if ( sbc->translatable )
1656                   dump (0, "msg (SE, gettext(\"%s\"));",buf);
1657           else
1658                   dump (0, "msg (SE, \"%s\");",buf);
1659           dump (0, "goto lossage;");
1660           dump (-1, "}");
1661       }
1662       dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1663       dump (-1,"}");
1664     }
1665   else if (sbc->type == SBC_PINT)
1666     {
1667       dump (0, "lex_match ('(');");
1668       dump (1, "if (!lex_force_int ())");
1669       dump (0, "goto lossage;");
1670       dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1671       dump (0, "lex_match (')');");
1672     }
1673   else if (sbc->type == SBC_DBL_LIST)
1674     {
1675       dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1676       dump (1, "{");
1677       dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1678       dump (0, "goto lossage;");
1679       dump (-1,"}");
1680
1681       dump (1, "while (token != '/' && token != '.')");
1682       dump (1, "{");
1683       dump (0, "lex_match(',');");
1684       dump (0, "if (!lex_force_num ())");
1685       dump (1, "{");
1686       dump (0, "goto lossage;");
1687       dump (-1,"}");
1688
1689       dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());",
1690             st_lower (sbc->name),st_lower (sbc->name)
1691             );
1692
1693       dump (0, "lex_get();");
1694       dump (-1,"}");
1695
1696     }
1697   else if (sbc->type == SBC_CUSTOM)
1698     {
1699       dump (1, "switch (%scustom_%s (p))",
1700             st_lower (prefix), st_lower (sbc->name));
1701       dump (0, "{");
1702       dump (1, "case 0:");
1703       dump (0, "goto lossage;");
1704       dump (-1, "case 1:");
1705       indent ();
1706       dump (0, "break;");
1707       dump (-1, "case 2:");
1708       indent ();
1709       dump (0, "lex_error (NULL);");
1710       dump (0, "goto lossage;");
1711       dump (-1, "default:");
1712       indent ();
1713       dump (0, "assert (0);");
1714       dump (-1, "}");
1715       outdent ();
1716     }
1717 }
1718
1719 /* Write out entire parser. */
1720 static void
1721 dump_parser (int persistent)
1722 {
1723   int f;
1724
1725   indent = 0;
1726
1727   dump (0, "static int");
1728   dump (0, "parse_%s (struct cmd_%s *p)", make_identifier (cmdname),
1729         make_identifier (cmdname));
1730   dump (1, "{");
1731
1732   dump_vars_init (persistent);
1733
1734   dump (1, "for (;;)");
1735   dump (1, "{");
1736
1737   f = 0;
1738   if (def && (def->type == SBC_VARLIST))
1739     {
1740       if (def->type == SBC_VARLIST)
1741         dump (1, "if (token == T_ID "
1742               "&& dict_lookup_var (default_dict, tokid) != NULL "
1743               "&& lex_look_ahead () != '=')");
1744       else
1745         {
1746           dump (0, "if ((token == T_ID "
1747                 "&& dict_lookup_var (default_dict, tokid) "
1748                 "&& lex_look_ahead () != '=')");
1749           dump (1, "     || token == T_ALL)");
1750         }
1751       dump (1, "{");
1752       dump (0, "p->sbc_%s++;", st_lower (def->name));
1753       dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1754             "PV_APPEND))",
1755             st_lower (def->prefix), st_lower (def->name),
1756             st_lower (def->prefix), st_lower (def->name));
1757       dump (0, "goto lossage;");
1758       dump (-2, "}");
1759       outdent ();
1760       f = 1;
1761     }
1762   else if (def && def->type == SBC_CUSTOM)
1763     {
1764       dump (1, "switch (%scustom_%s (p))",
1765             st_lower (prefix), st_lower (def->name));
1766       dump (0, "{");
1767       dump (1, "case 0:");
1768       dump (0, "goto lossage;");
1769       dump (-1, "case 1:");
1770       indent ();
1771       dump (0, "p->sbc_%s++;", st_lower (def->name));
1772       dump (0, "continue;");
1773       dump (-1, "case 2:");
1774       indent ();
1775       dump (0, "break;");
1776       dump (-1, "default:");
1777       indent ();
1778       dump (0, "assert (0);");
1779       dump (-1, "}");
1780       outdent ();
1781     }
1782
1783   {
1784     subcommand *sbc;
1785
1786     for (sbc = subcommands; sbc; sbc = sbc->next)
1787       {
1788         dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1789         f = 1;
1790         dump (1, "{");
1791
1792         dump (0, "lex_match ('=');");
1793         dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1794         if (sbc->arity != ARITY_MANY)
1795           {
1796             dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1797             dump (1, "{");
1798             dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1799                   sbc->name);
1800             dump (0, "goto lossage;");
1801             dump (-1, "}");
1802             outdent ();
1803           }
1804         dump_subcommand (sbc);
1805         dump (-1, "}");
1806         outdent ();
1807       }
1808   }
1809
1810
1811   /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1812   dump(1,"else if ( get_syntax() != COMPATIBLE && lex_match_id(\"ALGORITHM\"))");
1813   dump(1,"{");
1814
1815   dump (0, "lex_match ('=');");
1816
1817   dump(1,"if (lex_match_id(\"COMPATIBLE\"))");
1818   dump(0,"set_cmd_algorithm(COMPATIBLE);");
1819   outdent();
1820   dump(1,"else if (lex_match_id(\"ENHANCED\"))");
1821   dump(0,"set_cmd_algorithm(ENHANCED);");
1822
1823   dump (-1, "}");
1824   outdent ();
1825
1826
1827
1828   dump (1, "if (!lex_match ('/'))");
1829   dump (0, "break;");
1830   dump (-2, "}");
1831   outdent ();
1832   dump (0, nullstr);
1833   dump (1, "if (token != '.')");
1834   dump (1, "{");
1835   dump (0, "lex_error (_(\"expecting end of command\"));");
1836   dump (0, "goto lossage;");
1837   dump (-1, "}");
1838   dump (0, nullstr);
1839
1840   outdent ();
1841
1842   {
1843     /*  Check that mandatory subcommands have been specified  */
1844     subcommand *sbc;
1845
1846     for (sbc = subcommands; sbc; sbc = sbc->next)
1847       {
1848
1849         if ( sbc->arity == ARITY_ONCE_EXACTLY )
1850           {
1851             dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1852             dump (1, "{");
1853             dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
1854                   sbc->name);
1855             dump (0, "goto lossage;");
1856             dump (-1, "}");
1857             dump (0, nullstr);
1858           }
1859       }
1860   }
1861
1862   dump (-1, "return 1;");
1863   dump (0, nullstr);
1864   dump (-1, "lossage:");
1865   indent ();
1866   dump (0, "free_%s (p);", make_identifier (cmdname));
1867   dump (0, "return 0;");
1868   dump (-1, "}");
1869   dump (0, nullstr);
1870 }
1871
1872
1873 /* Write the output file header. */
1874 static void
1875 dump_header (void)
1876 {
1877   time_t curtime;
1878   struct tm *loctime;
1879   char *timep;
1880
1881   indent = 0;
1882   curtime = time (NULL);
1883   loctime = localtime (&curtime);
1884   timep = asctime (loctime);
1885   timep[strlen (timep) - 1] = 0;
1886   dump (0,   "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1887   dump (0, nullstr);
1888   dump (0, "   Generated by q2c from %s on %s.", ifn, timep);
1889   dump (0, "   Do not modify!");
1890   dump (0, " */");
1891 }
1892
1893 /* Write out commands to free variable state. */
1894 static void
1895 dump_free (int persistent)
1896 {
1897   subcommand *sbc;
1898   int used;
1899
1900   indent = 0;
1901
1902   used = 0;
1903   if ( ! persistent )
1904     {
1905       for (sbc = subcommands; sbc; sbc = sbc->next)
1906         {
1907         if (sbc->type == SBC_STRING)
1908           used = 1;
1909         if (sbc->type == SBC_DBL_LIST)
1910           used = 1;
1911         }
1912
1913     }
1914
1915   dump (0, "static void");
1916   dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1917         make_identifier (cmdname), used ? "" : " UNUSED");
1918   dump (1, "{");
1919
1920   if ( ! persistent )
1921     {
1922
1923       for (sbc = subcommands; sbc; sbc = sbc->next)
1924         {
1925           switch (sbc->type)
1926             {
1927             case SBC_VARLIST:
1928               dump (0, "free (p->v_%s);", st_lower (sbc->name));
1929               break;
1930             case SBC_STRING:
1931               dump (0, "free (p->s_%s);", st_lower (sbc->name));
1932               break;
1933             case SBC_DBL_LIST:
1934               dump (0, "int i;");
1935               dump (1, "for(i = 0; i < MAXLISTS ; ++i)");
1936               dump (0, "subc_list_double_destroy(&p->dl_%s[i]);", st_lower (sbc->name));
1937               outdent();
1938               break;
1939             default:
1940               break;
1941             }
1942         }
1943     }
1944
1945   dump (-1, "}");
1946
1947 }
1948
1949
1950
1951 /* Returns the name of a directive found on the current input line, if
1952    any, or a null pointer if none found. */
1953 static const char *
1954 recognize_directive (void)
1955 {
1956   static char directive[16];
1957   char *sp, *ep;
1958
1959   sp = skip_ws (buf);
1960   if (strncmp (sp, "/*", 2))
1961     return NULL;
1962   sp = skip_ws (sp + 2);
1963   if (*sp != '(')
1964     return NULL;
1965   sp++;
1966
1967   ep = strchr (sp, ')');
1968   if (ep == NULL)
1969     return NULL;
1970
1971   if (ep - sp > 15)
1972     ep = sp + 15;
1973   memcpy (directive, sp, ep - sp);
1974   directive[ep - sp] = '\0';
1975   return directive;
1976 }
1977
1978 int
1979 main (int argc, char *argv[])
1980 {
1981   program_name = argv[0];
1982   if (argc != 3)
1983     fail ("Syntax: q2c input.q output.c");
1984
1985   ifn = argv[1];
1986   in = fopen (ifn, "r");
1987   if (!in)
1988     fail ("%s: open: %s.", ifn, strerror (errno));
1989
1990   ofn = argv[2];
1991   out = fopen (ofn, "w");
1992   if (!out)
1993     fail ("%s: open: %s.", ofn, strerror (errno));
1994
1995   is_open = 1;
1996   buf = xmalloc (MAX_LINE_LEN);
1997   tokstr = xmalloc (MAX_TOK_LEN);
1998
1999   dump_header ();
2000
2001
2002   indent = 0;
2003   dump (0, "#line %d \"%s\"", ln + 1, ifn);
2004   while (get_line ())
2005     {
2006       const char *directive = recognize_directive ();
2007       if (directive == NULL)
2008         {
2009           dump (0, "%s", buf);
2010           continue;
2011         }
2012
2013       dump (0, "#line %d \"%s\"", oln + 1, ofn);
2014       if (!strcmp (directive, "specification"))
2015         {
2016           /* Skip leading slash-star line. */
2017           get_line ();
2018           lex_get ();
2019
2020           parse ();
2021
2022           /* Skip trailing star-slash line. */
2023           get_line ();
2024         }
2025       else if (!strcmp (directive, "headers"))
2026         {
2027           indent = 0;
2028
2029           dump (0, "#include <stdlib.h>");
2030           dump (0, "#include <libpspp/alloc.h>");
2031           dump (0, "#include <libpspp/message.h>");
2032           dump (0, "#include <language/lexer/lexer.h>");
2033           dump (0, "#include <data/settings.h>");
2034           dump (0, "#include <libpspp/str.h>");
2035           dump (0, "#include <language/lexer/subcommand-list.h>");
2036           dump (0, "#include <data/variable.h>");
2037           dump (0, nullstr);
2038
2039           dump (0, "#include \"gettext.h\"");
2040           dump (0, "#define _(msgid) gettext (msgid)");
2041           dump (0, nullstr);
2042         }
2043       else if (!strcmp (directive, "declarations"))
2044         dump_declarations ();
2045       else if (!strcmp (directive, "functions"))
2046         {
2047           dump_parser (0);
2048           dump_free (0);
2049         }
2050       else if (!strcmp (directive, "_functions"))
2051         {
2052           dump_parser (1);
2053           dump_free (1);
2054         }
2055       else
2056         error ("unknown directive `%s'", directive);
2057       indent = 0;
2058       dump (0, "#line %d \"%s\"", ln + 1, ifn);
2059     }
2060
2061
2062
2063   return EXIT_SUCCESS;
2064 }