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