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