src/language/lexer/q2c.c

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