src/language/lexer/q2c.c

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