+++ /dev/null
-/* PSPP - a program for statistical analysis.
- Copyright (C) 1997-9, 2000, 2008, 2010, 2011 Free Software Foundation, Inc.
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
-
-#include <assert.h>
-#include <ctype.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdarg.h>
-#include <stdbool.h>
-#include <string.h>
-#include <errno.h>
-#include <unistd.h>
-
-/* GNU C allows the programmer to declare that certain functions take
- printf-like arguments, never return, etc. Conditionalize these
- declarations on whether gcc is in use. */
-#if __GNUC__ > 1
-#define ATTRIBUTE(X) __attribute__ (X)
-#else
-#define ATTRIBUTE(X)
-#endif
-
-/* Marks a function argument as possibly not used. */
-#define UNUSED ATTRIBUTE ((unused))
-
-/* Marks a function that will never return. */
-#define NO_RETURN ATTRIBUTE ((noreturn))
-
-/* Mark a function as taking a printf- or scanf-like format
- string as its FMT'th argument and that the FIRST'th argument
- is the first one to be checked against the format string. */
-#define PRINTF_FORMAT(FMT, FIRST) ATTRIBUTE ((format (__printf__, FMT, FIRST)))
-
-/* Max length of an input line. */
-#define MAX_LINE_LEN 1024
-
-/* Max token length. */
-#define MAX_TOK_LEN 1024
-
-/* argv[0]. */
-static char *program_name;
-
-/* Have the input and output files been opened yet? */
-static bool is_open;
-
-/* Input, output files. */
-static FILE *in, *out;
-
-/* Input, output file names. */
-static char *ifn, *ofn;
-
-/* Input, output file line number. */
-static int ln, oln = 1;
-
-/* Input line buffer, current position. */
-static char *buf, *cp;
-
-/* Token types. */
-enum
- {
- T_STRING = 256, /* String literal. */
- T_ID = 257 /* Identifier. */
- };
-
-/* Current token: either one of the above, or a single character. */
-static int token;
-
-/* Token string value. */
-static char *tokstr;
-\f
-/* Utility functions. */
-
-/* Close all open files and delete the output file, on failure. */
-static void
-finish_up (void)
-{
- if (!is_open)
- return;
- is_open = false;
- fclose (in);
- fclose (out);
- if (remove (ofn) == -1)
- fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
-}
-
-void hcf (void) NO_RETURN;
-
-/* Terminate unsuccessfully. */
-void
-hcf (void)
-{
- finish_up ();
- exit (EXIT_FAILURE);
-}
-
-int fail (const char *, ...) PRINTF_FORMAT (1, 2) NO_RETURN;
-int error (const char *, ...) PRINTF_FORMAT (1, 2) NO_RETURN;
-
-/* Output an error message and terminate unsuccessfully. */
-int
-fail (const char *format, ...)
-{
- va_list args;
-
- va_start (args, format);
- fprintf (stderr, "%s: ", program_name);
- vfprintf (stderr, format, args);
- fprintf (stderr, "\n");
- va_end (args);
-
- hcf ();
-}
-
-/* Output a context-dependent error message and terminate
- unsuccessfully. */
-int
-error (const char *format,...)
-{
- va_list args;
-
- va_start (args, format);
- fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
- vfprintf (stderr, format, args);
- fprintf (stderr, "\n");
- va_end (args);
-
- hcf ();
-}
-
-#define VME "virtual memory exhausted"
-
-/* Allocate a block of SIZE bytes and return a pointer to its
- beginning. */
-static void *
-xmalloc (size_t size)
-{
- void *vp;
-
- if (size == 0)
- return NULL;
-
- vp = malloc (size);
- if (!vp)
- fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
-
- return vp;
-}
-
-/* Make a dynamically allocated copy of string S and return a pointer
- to the first character. */
-static char *
-xstrdup (const char *s)
-{
- size_t size;
- char *t;
-
- assert (s != NULL);
- size = strlen (s) + 1;
-
- t = malloc (size);
- if (!t)
- fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
-
- memcpy (t, s, size);
- return t;
-}
-
-/* Returns a pointer to one of 8 static buffers. The buffers are used
- in rotation. */
-static char *
-get_buffer (void)
-{
- static char b[8][256];
- static int cb;
-
- if (++cb >= 8)
- cb = 0;
-
- return b[cb];
-}
-
-/* Copies a string to a static buffer, converting it to lowercase in
- the process, and returns a pointer to the static buffer. */
-static char *
-st_lower (const char *s)
-{
- char *p, *cp;
-
- p = cp = get_buffer ();
- while (*s)
- *cp++ = tolower ((unsigned char) (*s++));
- *cp++ = '\0';
-
- return p;
-}
-
-/* Copies a string to a static buffer, converting it to uppercase in
- the process, and returns a pointer to the static buffer. */
-static char *
-st_upper (const char *s)
-{
- char *p, *cp;
-
- p = cp = get_buffer ();
- while (*s)
- *cp++ = toupper ((unsigned char) (*s++));
- *cp++ = '\0';
-
- return p;
-}
-
-/* Returns the address of the first non-whitespace character in S, or
- the address of the null terminator if none. */
-static char *
-skip_ws (char *s)
-{
- while (isspace ((unsigned char) *s))
- s++;
- return s;
-}
-
-/* Read one line from the input file into buf. Lines having special
- formats are handled specially. */
-static bool
-get_line (void)
-{
- ln++;
- if (0 == fgets (buf, MAX_LINE_LEN, in))
- {
- if (ferror (in))
- fail ("%s: fgets: %s", ifn, strerror (errno));
- return false;
- }
-
- cp = strchr (buf, '\n');
- if (cp != NULL)
- *cp = '\0';
-
- cp = buf;
- return true;
-}
-\f
-/* Symbol table manager. */
-
-/* Symbol table entry. */
-typedef struct symbol symbol;
-struct symbol
- {
- symbol *next; /* Next symbol in symbol table. */
- char *name; /* Symbol name. */
- int unique; /* 1=Name must be unique in this file. */
- int ln; /* Line number of definition. */
- int value; /* Symbol value. */
- };
-
-/* Symbol table. */
-symbol *symtab;
-
-/* Add a symbol to the symbol table having name NAME, uniqueness
- UNIQUE, and value VALUE. If a symbol having the same name is found
- in the symbol table, its sequence number is returned and the symbol
- table is not modified. Otherwise, the symbol is added and the next
- available sequence number is returned. */
-static int
-add_symbol (const char *name, int unique, int value)
-{
- symbol *iter, *sym;
- int x;
-
- sym = xmalloc (sizeof *sym);
- sym->name = xstrdup (name);
- sym->unique = unique;
- sym->value = value;
- sym->next = NULL;
- sym->ln = ln;
- if (!symtab)
- {
- symtab = sym;
- return 1;
- }
- iter = symtab;
- x = 1;
- for (;;)
- {
- if (!strcmp (iter->name, name))
- {
- if (iter->unique)
- {
- fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
- ln, name);
- fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
- iter->ln);
- hcf ();
- }
- free (sym->name);
- free (sym);
- return x;
- }
- if (!iter->next)
- break;
- iter = iter->next;
- x++;
- }
- iter->next = sym;
- return ++x;
-}
-
-/* Finds the symbol having given sequence number X within the symbol
- table, and returns the associated symbol structure. */
-static symbol *
-find_symbol (int x)
-{
- symbol *iter;
-
- iter = symtab;
- while (x > 1 && iter)
- {
- iter = iter->next;
- x--;
- }
- assert (iter);
- return iter;
-}
-
-#if DUMP_TOKENS
-/* Writes a printable representation of the current token to
- stdout. */
-static void
-dump_token (void)
-{
- switch (token)
- {
- case T_STRING:
- printf ("STRING\t\"%s\"\n", tokstr);
- break;
- case T_ID:
- printf ("ID\t%s\n", tokstr);
- break;
- default:
- printf ("PUNCT\t%c\n", token);
- }
-}
-#endif /* DUMP_TOKENS */
-
-
-const char hyphen_proxy = '_';
-
-static void
-id_cpy (char **cp)
-{
- char *dest = tokstr;
- char *src = *cp;
-
- while (*src == '_' || *src == '-' || isalnum ((unsigned char) *src))
- {
- *dest++ = *src == '-' ? hyphen_proxy :toupper ((unsigned char) (*src));
- src++;
- }
-
- *cp = src;
- *dest++ = '\0';
-}
-
-static char *
-unmunge (const char *s)
-{
- char *dest = xmalloc (strlen (s) + 1);
- char *d = dest;
-
- while (*s)
- {
- if (*s == hyphen_proxy)
- *d = '-';
- else
- *d = *s;
- s++;
- d++;
- }
- *d = '\0';
-
- return dest;
-}
-
-/* Reads a token from the input file. */
-static int
-lex_get (void)
-{
- /* Skip whitespace and check for end of file. */
- for (;;)
- {
- cp = skip_ws (cp);
- if (*cp != '\0')
- break;
-
- if (!get_line ())
- fail ("%s: Unexpected end of file.", ifn);
- }
-
- if (*cp == '"')
- {
- char *dest = tokstr;
- token = T_STRING;
- cp++;
- while (*cp != '"' && *cp)
- {
- if (*cp == '\\')
- {
- cp++;
- if (!*cp)
- error ("Unterminated string literal.");
- *dest++ = *cp++;
- }
- else
- *dest++ = *cp++;
- }
- *dest++ = 0;
- if (!*cp)
- error ("Unterminated string literal.");
- cp++;
- }
- else if (*cp == '_' || isalnum ((unsigned char) *cp))
- {
- char *dest = tokstr;
- token = T_ID;
-
- id_cpy (&cp);
- }
- else
- token = *cp++;
-
-#if DUMP_TOKENS
- dump_token ();
-#endif
-
- return token;
-}
-
-/* Force the current token to be an identifier token. */
-static void
-force_id (void)
-{
- if (token != T_ID)
- error ("Identifier expected.");
-}
-
-/* Force the current token to be a string token. */
-static void
-force_string (void)
-{
- if (token != T_STRING)
- error ("String expected.");
-}
-
-/* Checks whether the current token is the identifier S; if so, skips
- the token and returns true; otherwise, returns false. */
-static bool
-match_id (const char *s)
-{
- if (token == T_ID && !strcmp (tokstr, s))
- {
- lex_get ();
- return true;
- }
- return false;
-}
-
-/* Checks whether the current token is T. If so, skips the token and
- returns true; otherwise, returns false. */
-static bool
-match_token (int t)
-{
- if (token == t)
- {
- lex_get ();
- return true;
- }
- return false;
-}
-
-/* Force the current token to be T, and skip it. */
-static void
-skip_token (int t)
-{
- if (token != t)
- error ("`%c' expected.", t);
- lex_get ();
-}
-\f
-/* Structures. */
-
-/* Some specifiers have associated values. */
-enum
- {
- VAL_NONE, /* No value. */
- VAL_INT, /* Integer value. */
- VAL_DBL, /* Floating point value. */
- VAL_STRING /* String value. */
- };
-
-/* For those specifiers with values, the syntax of those values. */
-enum
- {
- VT_PLAIN, /* Unadorned value. */
- VT_PAREN /* Value must be enclosed in parentheses. */
- };
-
-/* Forward definition. */
-typedef struct specifier specifier;
-
-/* A single setting. */
-typedef struct setting setting;
-struct setting
- {
- specifier *parent; /* Owning specifier. */
- setting *next; /* Next in the chain. */
- char *specname; /* Name of the setting. */
- int con; /* Sequence number. */
-
- /* Values. */
- int valtype; /* One of VT_*. */
- int value; /* One of VAL_*. */
- int optvalue; /* 1=value is optional, 0=value is required. */
- char *valname; /* Variable name for the value. */
- char *restriction; /* !=NULL: expression specifying valid values. */
- };
-
-/* A single specifier. */
-struct specifier
- {
- specifier *next; /* Next in the chain. */
- char *varname; /* Variable name. */
- setting *s; /* Associated settings. */
-
- setting *def; /* Default setting. */
- setting *omit_kw; /* Setting for which the keyword can be omitted. */
-
- int index; /* Next array index. */
- };
-
-/* Subcommand types. */
-typedef enum
- {
- SBC_PLAIN, /* The usual case. */
- SBC_VARLIST, /* Variable list. */
- SBC_INT, /* Integer value. */
- SBC_PINT, /* Integer inside parentheses. */
- SBC_DBL, /* Floating point value. */
- SBC_INT_LIST, /* List of integers (?). */
- SBC_DBL_LIST, /* List of floating points (?). */
- SBC_CUSTOM, /* Custom. */
- SBC_ARRAY, /* Array of boolean values. */
- SBC_STRING, /* String value. */
- SBC_VAR /* Single variable name. */
- }
-subcommand_type;
-
-typedef enum
- {
- ARITY_ONCE_EXACTLY, /* must occur exactly once */
- ARITY_ONCE_ONLY, /* zero or once */
- ARITY_MANY /* 0, 1, ... , inf */
- }subcommand_arity;
-
-/* A single subcommand. */
-typedef struct subcommand subcommand;
-struct subcommand
- {
- subcommand *next; /* Next in the chain. */
- char *name; /* Subcommand name. */
- subcommand_type type; /* One of SBC_*. */
- subcommand_arity arity; /* How many times should the subcommand occur*/
- int narray; /* Index of next array element. */
- const char *prefix; /* Prefix for variable and constant names. */
- specifier *spec; /* Array of specifiers. */
- char *pv_options; /* PV_* options for SBC_VARLIST. */
- };
-
-/* Name of the command; i.e., DESCRIPTIVES. */
-char *cmdname;
-
-/* Short prefix for the command; i.e., `dsc_'. */
-char *prefix;
-
-/* List of subcommands. */
-subcommand *subcommands;
-
-/* Default subcommand if any, or NULL. */
-subcommand *def;
-\f
-/* Parsing. */
-
-void parse_subcommands (void);
-
-/* Parse an entire specification. */
-static void
-parse (void)
-{
- /* Get the command name and prefix. */
- if (token != T_STRING && token != T_ID)
- error ("Command name expected.");
- cmdname = xstrdup (tokstr);
- lex_get ();
- skip_token ('(');
- force_id ();
- prefix = xstrdup (tokstr);
- lex_get ();
- skip_token (')');
- skip_token (':');
-
- /* Read all the subcommands. */
- subcommands = NULL;
- def = NULL;
- parse_subcommands ();
-}
-
-/* Parses a single setting into S, given subcommand information SBC
- and specifier information SPEC. */
-static void
-parse_setting (setting *s, specifier *spec)
-{
- s->parent = spec;
-
- if (match_token ('*'))
- {
- if (spec->omit_kw)
- error ("Cannot have two settings with omittable keywords.");
- else
- spec->omit_kw = s;
- }
-
- if (match_token ('!'))
- {
- if (spec->def)
- error ("Cannot have two default settings.");
- else
- spec->def = s;
- }
-
- force_id ();
- s->specname = xstrdup (tokstr);
- s->con = add_symbol (s->specname, 0, 0);
- s->value = VAL_NONE;
-
- lex_get ();
-
- /* Parse setting value info if necessary. */
- if (token != '/' && token != ';' && token != '.' && token != ',')
- {
- if (token == '(')
- {
- s->valtype = VT_PAREN;
- lex_get ();
- }
- else
- s->valtype = VT_PLAIN;
-
- s->optvalue = match_token ('*');
-
- if (match_id ("N"))
- s->value = VAL_INT;
- else if (match_id ("D"))
- s->value = VAL_DBL;
- else if (match_id ("S"))
- s->value = VAL_STRING;
- else
- error ("`n', `d', or `s' expected.");
-
- skip_token (':');
-
- force_id ();
- s->valname = xstrdup (tokstr);
- lex_get ();
-
- if (token == ',')
- {
- lex_get ();
- force_string ();
- s->restriction = xstrdup (tokstr);
- lex_get ();
- }
- else
- s->restriction = NULL;
-
- if (s->valtype == VT_PAREN)
- skip_token (')');
- }
-}
-
-/* Parse a single specifier into SPEC, given subcommand information
- SBC. */
-static void
-parse_specifier (specifier *spec, subcommand *sbc)
-{
- spec->index = 0;
- spec->s = NULL;
- spec->def = NULL;
- spec->omit_kw = NULL;
- spec->varname = NULL;
-
- if (token == T_ID)
- {
- spec->varname = xstrdup (st_lower (tokstr));
- lex_get ();
- }
-
- /* Handle array elements. */
- if (token != ':')
- {
- spec->index = sbc->narray;
- if (sbc->type == SBC_ARRAY)
- {
- if (token == '|')
- token = ',';
- else
- sbc->narray++;
- }
- spec->s = NULL;
- return;
- }
- skip_token (':');
-
- if (sbc->type == SBC_ARRAY && token == T_ID)
- {
- spec->varname = xstrdup (st_lower (tokstr));
- spec->index = sbc->narray;
- sbc->narray++;
- }
-
-
-
- /* Parse all the settings. */
- {
- setting **s = &spec->s;
-
- for (;;)
- {
- *s = xmalloc (sizeof **s);
- parse_setting (*s, spec);
- if (token == ',' || token == ';' || token == '.')
- break;
- skip_token ('/');
- s = &(*s)->next;
- }
- (*s)->next = NULL;
- }
-}
-
-/* Parse a list of specifiers for subcommand SBC. */
-static void
-parse_specifiers (subcommand *sbc)
-{
- specifier **spec = &sbc->spec;
-
- if (token == ';' || token == '.')
- {
- *spec = NULL;
- return;
- }
-
- for (;;)
- {
- *spec = xmalloc (sizeof **spec);
- parse_specifier (*spec, sbc);
- if (token == ';' || token == '.')
- break;
- skip_token (',');
- spec = &(*spec)->next;
- }
- (*spec)->next = NULL;
-}
-
-/* Parse a subcommand into SBC. */
-static void
-parse_subcommand (subcommand *sbc)
-{
- if (match_token ('*'))
- {
- if (def)
- error ("Multiple default subcommands.");
- def = sbc;
- }
-
- sbc->arity = ARITY_ONCE_ONLY;
- if (match_token('+'))
- sbc->arity = ARITY_MANY;
- else if (match_token('^'))
- sbc->arity = ARITY_ONCE_EXACTLY ;
-
-
- force_id ();
- sbc->name = xstrdup (tokstr);
- lex_get ();
-
- sbc->narray = 0;
- sbc->type = SBC_PLAIN;
- sbc->spec = NULL;
-
- if (match_token ('['))
- {
- force_id ();
- sbc->prefix = xstrdup (st_lower (tokstr));
- lex_get ();
-
- skip_token (']');
- skip_token ('=');
-
- sbc->type = SBC_ARRAY;
- parse_specifiers (sbc);
-
- }
- else
- {
- if (match_token ('('))
- {
- force_id ();
- sbc->prefix = xstrdup (st_lower (tokstr));
- lex_get ();
-
- skip_token (')');
- }
- else
- sbc->prefix = "";
-
- skip_token ('=');
-
- if (match_id ("VAR"))
- sbc->type = SBC_VAR;
- if (match_id ("VARLIST"))
- {
- if (match_token ('('))
- {
- force_string ();
- sbc->pv_options = xstrdup (tokstr);
- lex_get();
-
- skip_token (')');
- }
- else
- sbc->pv_options = NULL;
-
- sbc->type = SBC_VARLIST;
- }
- else if (match_id ("INTEGER"))
- sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
- else if (match_id ("PINT"))
- sbc->type = SBC_PINT;
- else if (match_id ("DOUBLE"))
- {
- if (match_id ("LIST"))
- sbc->type = SBC_DBL_LIST;
- else
- sbc->type = SBC_DBL;
- }
- else if (match_id ("STRING"))
- sbc->type = SBC_STRING;
- else if (match_id ("CUSTOM"))
- sbc->type = SBC_CUSTOM;
- else
- parse_specifiers (sbc);
- }
-}
-
-/* Parse all the subcommands. */
-void
-parse_subcommands (void)
-{
- subcommand **sbc = &subcommands;
-
- for (;;)
- {
- *sbc = xmalloc (sizeof **sbc);
- (*sbc)->next = NULL;
-
- parse_subcommand (*sbc);
-
- if (token == '.')
- return;
-
- skip_token (';');
- sbc = &(*sbc)->next;
- }
-}
-\f
-/* Output. */
-
-#define BASE_INDENT 2 /* Starting indent. */
-#define INC_INDENT 2 /* Indent increment. */
-
-/* Increment the indent. */
-#define indent() indent += INC_INDENT
-#define outdent() indent -= INC_INDENT
-
-/* Size of the indent from the left margin. */
-int indent;
-
-void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
-
-/* Write line FORMAT to the output file, formatted as with printf,
- indented `indent' characters from the left margin. If INDENTION is
- greater than 0, indents BASE_INDENT * INDENTION characters after
- writing the line; if INDENTION is less than 0, dedents BASE_INDENT
- * INDENTION characters _before_ writing the line. */
-void
-dump (int indention, const char *format, ...)
-{
- va_list args;
- int i;
-
- if (indention < 0)
- indent += BASE_INDENT * indention;
-
- oln++;
- va_start (args, format);
- for (i = 0; i < indent; i++)
- putc (' ', out);
- vfprintf (out, format, args);
- putc ('\n', out);
- va_end (args);
-
- if (indention > 0)
- indent += BASE_INDENT * indention;
-}
-
-/* Writes a blank line to the output file and adjusts 'indent' by BASE_INDENT
- * INDENTION characters.
-
- (This is only useful because GCC complains about using "" as a format
- string, for whatever reason.) */
-static void
-dump_blank_line (int indention)
-{
- oln++;
- indent += BASE_INDENT * indention;
- putc ('\n', out);
-}
-
-/* Write the structure members for specifier SPEC to the output file.
- SBC is the including subcommand. */
-static void
-dump_specifier_vars (const specifier *spec, const subcommand *sbc)
-{
- if (spec->varname)
- dump (0, "long %s%s;", sbc->prefix, spec->varname);
-
- {
- setting *s;
-
- for (s = spec->s; s; s = s->next)
- {
- if (s->value != VAL_NONE)
- {
- const char *typename;
-
- assert (s->value == VAL_INT || s->value == VAL_DBL
- || s->value == VAL_STRING);
- typename = (s->value == VAL_INT ? "long"
- : s->value == VAL_DBL ? "double"
- : "char *");
-
- dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
- }
- }
- }
-}
-
-/* Returns true if string T is a PSPP keyword, false otherwise. */
-static bool
-is_keyword (const char *t)
-{
- static const char *kw[] =
- {
- "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
- "NE", "ALL", "BY", "TO", "WITH", 0,
- };
- const char **cp;
-
- for (cp = kw; *cp; cp++)
- if (!strcmp (t, *cp))
- return true;
- return false;
-}
-
-/* Transforms a string NAME into a valid C identifier: makes
- everything lowercase and maps nonalphabetic characters to
- underscores. Returns a pointer to a static buffer. */
-static char *
-make_identifier (const char *name)
-{
- char *p = get_buffer ();
- char *cp;
-
- for (cp = p; *name; name++)
- if (isalpha ((unsigned char) *name))
- *cp++ = tolower ((unsigned char) (*name));
- else
- *cp++ = '_';
- *cp = '\0';
-
- return p;
-}
-
-/* Writes the struct and enum declarations for the parser. */
-static void
-dump_declarations (void)
-{
- indent = 0;
-
- dump (0, "struct dataset;");
-
- /* Write out enums for all the identifiers in the symbol table. */
- {
- int f, k;
- symbol *sym;
- char *buf = NULL;
-
- /* Note the squirmings necessary to make sure that the last enum
- is not followed by a comma, as mandated by ANSI C89. */
- for (sym = symtab, f = k = 0; sym; sym = sym->next)
- if (!sym->unique && !is_keyword (sym->name))
- {
- if (!f)
- {
- dump (0, "/* Settings for subcommand specifiers. */");
- dump (1, "enum");
- dump (1, "{");
- f = 1;
- }
-
- if (buf == NULL)
- buf = xmalloc (1024);
- else
- dump (0, "%s", buf);
-
- if (k)
- sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
- else
- {
- k = 1;
- sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
- }
- }
- if (buf)
- {
- buf[strlen (buf) - 1] = 0;
- dump (0, "%s", buf);
- free (buf);
- }
- if (f)
- {
- dump (-1, "};");
- dump_blank_line (-1);
- }
- }
-
- /* Write out some type definitions */
- {
- dump (0, "#define MAXLISTS 10");
- }
-
-
- /* For every array subcommand, write out the associated enumerated
- values. */
- {
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- if (sbc->type == SBC_ARRAY && sbc->narray)
- {
- dump (0, "/* Array indices for %s subcommand. */", sbc->name);
-
- dump (1, "enum");
- dump (1, "{");
-
- {
- specifier *spec;
-
- for (spec = sbc->spec; spec; spec = spec->next)
- dump (0, "%s%s%s = %d,",
- st_upper (prefix), st_upper (sbc->prefix),
- st_upper (spec->varname), spec->index);
-
- dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
-
- dump (-1, "};");
- dump_blank_line (-1);
- }
- }
- }
-
- /* Write out structure declaration. */
- {
- subcommand *sbc;
-
- dump (0, "/* %s structure. */", cmdname);
- dump (1, "struct cmd_%s", make_identifier (cmdname));
- dump (1, "{");
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- int f = 0;
-
- if (sbc != subcommands)
- dump_blank_line (0);
-
- dump (0, "/* %s subcommand. */", sbc->name);
- dump (0, "int sbc_%s;", st_lower (sbc->name));
-
- switch (sbc->type)
- {
- case SBC_ARRAY:
- case SBC_PLAIN:
- {
- specifier *spec;
-
- for (spec = sbc->spec; spec; spec = spec->next)
- {
- if (spec->s == 0)
- {
- if (sbc->type == SBC_PLAIN)
- dump (0, "long int %s%s;", st_lower (sbc->prefix),
- spec->varname);
- else if (f == 0)
- {
- dump (0, "int a_%s[%s%scount];",
- st_lower (sbc->name),
- st_upper (prefix),
- st_upper (sbc->prefix)
- );
-
- f = 1;
- }
- }
- else
- dump_specifier_vars (spec, sbc);
- }
- }
- break;
-
- case SBC_VARLIST:
- dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
- st_lower (sbc->name));
- dump (0, "const struct variable **%sv_%s;", st_lower (sbc->prefix),
- st_lower (sbc->name));
- break;
-
- case SBC_VAR:
- dump (0, "const struct variable *%sv_%s;", st_lower (sbc->prefix),
- st_lower (sbc->name));
- break;
-
- case SBC_STRING:
- dump (0, "char *s_%s;", st_lower (sbc->name));
- break;
-
- case SBC_INT:
- case SBC_PINT:
- dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
- break;
-
- case SBC_DBL:
- dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
- break;
-
- case SBC_DBL_LIST:
- dump (0, "subc_list_double dl_%s[MAXLISTS];",
- st_lower(sbc->name));
- break;
-
- case SBC_INT_LIST:
- dump (0, "subc_list_int il_%s[MAXLISTS];",
- st_lower(sbc->name));
- break;
-
-
- default:;
- /* nothing */
- }
- }
-
- dump (-1, "};");
- dump_blank_line (-1);
- }
-
- /* Write out prototypes for custom_*() functions as necessary. */
- {
- bool seen = false;
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- if (sbc->type == SBC_CUSTOM)
- {
- if (!seen)
- {
- seen = true;
- dump (0, "/* Prototype for custom subcommands of %s. */",
- cmdname);
- }
- dump (0, "static int %scustom_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
- st_lower (prefix), st_lower (sbc->name),
- make_identifier (cmdname));
- }
-
- if (seen)
- dump_blank_line (0);
- }
-
- /* Prototypes for parsing and freeing functions. */
- {
- dump (0, "/* Command parsing functions. */");
- dump (0, "static int parse_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
- make_identifier (cmdname), make_identifier (cmdname));
- dump (0, "static void free_%s (struct cmd_%s *);",
- make_identifier (cmdname), make_identifier (cmdname));
- dump_blank_line (0);
- }
-}
-
-/* Writes out code to initialize all the variables that need
- initialization for particular specifier SPEC inside subcommand SBC. */
-static void
-dump_specifier_init (const specifier *spec, const subcommand *sbc)
-{
- if (spec->varname)
- {
- char s[256];
-
- if (spec->def)
- sprintf (s, "%s%s",
- st_upper (prefix), find_symbol (spec->def->con)->name);
- else
- strcpy (s, "-1");
- dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
- }
-
- {
- setting *s;
-
- for (s = spec->s; s; s = s->next)
- {
- if (s->value != VAL_NONE)
- {
- const char *init;
-
- assert (s->value == VAL_INT || s->value == VAL_DBL
- || s->value == VAL_STRING);
- init = (s->value == VAL_INT ? "LONG_MIN"
- : s->value == VAL_DBL ? "SYSMIS"
- : "NULL");
-
- dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
- }
- }
- }
-}
-
-/* Write code to initialize all variables. */
-static void
-dump_vars_init (int persistent)
-{
- /* Loop through all the subcommands. */
- {
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- int f = 0;
-
- dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
- if (! persistent)
- {
- switch (sbc->type)
- {
- case SBC_INT_LIST:
- case SBC_DBL_LIST:
- dump (1, "{");
- dump (0, "int i;");
- dump (1, "for (i = 0; i < MAXLISTS; ++i)");
- dump (0, "subc_list_%s_create(&p->%cl_%s[i]) ;",
- sbc->type == SBC_INT_LIST ? "int" : "double",
- sbc->type == SBC_INT_LIST ? 'i' : 'd',
- st_lower (sbc->name)
- );
- dump (-2, "}");
- break;
-
- case SBC_DBL:
- dump (1, "{");
- dump (0, "int i;");
- dump (1, "for (i = 0; i < MAXLISTS; ++i)");
- dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
- dump (-2, "}");
- break;
-
- case SBC_CUSTOM:
- /* nothing */
- break;
-
- case SBC_PLAIN:
- case SBC_ARRAY:
- {
- specifier *spec;
-
- for (spec = sbc->spec; spec; spec = spec->next)
- if (spec->s == NULL)
- {
- if (sbc->type == SBC_PLAIN)
- dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
- else if (f == 0)
- {
- dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
- st_lower (sbc->name), st_lower (sbc->name));
- f = 1;
- }
- }
- else
- dump_specifier_init (spec, sbc);
- }
- break;
-
- case SBC_VARLIST:
- dump (0, "p->%sn_%s = 0;",
- st_lower (sbc->prefix), st_lower (sbc->name));
- dump (0, "p->%sv_%s = NULL;",
- st_lower (sbc->prefix), st_lower (sbc->name));
- break;
-
- case SBC_VAR:
- dump (0, "p->%sv_%s = NULL;",
- st_lower (sbc->prefix), st_lower (sbc->name));
- break;
-
- case SBC_STRING:
- dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
- break;
-
- case SBC_INT:
- case SBC_PINT:
- dump (1, "{");
- dump (0, "int i;");
- dump (1, "for (i = 0; i < MAXLISTS; ++i)");
- dump (0, "p->n_%s[i] = LONG_MIN;", st_lower (sbc->name));
- dump (-2, "}");
- break;
-
- default:
- abort ();
- }
- }
- }
- }
-}
-
-/* Return a pointer to a static buffer containing an expression that
- will match token T. */
-static char *
-make_match (const char *t)
-{
- char *s;
-
- s = get_buffer ();
-
- while (*t == '_')
- t++;
-
- if (is_keyword (t))
- sprintf (s, "lex_match (lexer, T_%s)", t);
- else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
- strcpy (s, "(lex_match_id (lexer, \"ON\") || lex_match_id (lexer, \"YES\") "
- "|| lex_match_id (lexer, \"TRUE\"))");
- else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
- strcpy (s, "(lex_match_id (lexer, \"OFF\") || lex_match_id (lexer, \"NO\") "
- "|| lex_match_id (lexer, \"FALSE\"))");
- else if (isdigit ((unsigned char) t[0]))
- sprintf (s, "lex_match_int (lexer, %s)", t);
- else if (strchr (t, hyphen_proxy))
- {
- char *c = unmunge (t);
- sprintf (s, "lex_match_phrase (lexer, \"%s\")", c);
- free (c);
- }
- else
- sprintf (s, "lex_match_id (lexer, \"%s\")", t);
-
- return s;
-}
-
-/* Write out the parsing code for specifier SPEC within subcommand
- SBC. */
-static void
-dump_specifier_parse (const specifier *spec, const subcommand *sbc)
-{
- setting *s;
-
- if (spec->omit_kw && spec->omit_kw->next)
- error ("Omittable setting is not last setting in `%s' specifier.",
- spec->varname);
- if (spec->omit_kw && spec->omit_kw->parent->next)
- error ("Default specifier is not in last specifier in `%s' "
- "subcommand.", sbc->name);
-
- for (s = spec->s; s; s = s->next)
- {
- int first = spec == sbc->spec && s == spec->s;
-
- /* Match the setting's keyword. */
- if (spec->omit_kw == s)
- {
- if (!first)
- {
- dump (1, "else");
- dump (1, "{");
- }
- dump (1, "%s;", make_match (s->specname));
- }
- else
- dump (1, "%sif (%s)", first ? "" : "else ",
- make_match (s->specname));
-
-
- /* Handle values. */
- if (s->value == VAL_NONE)
- dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
- st_upper (prefix), find_symbol (s->con)->name);
- else
- {
- if (spec->omit_kw != s)
- dump (1, "{");
-
- if (spec->varname)
- {
- dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
- st_upper (prefix), find_symbol (s->con)->name);
-
- if (sbc->type == SBC_ARRAY)
- dump (0, "p->a_%s[%s%s%s] = 1;",
- st_lower (sbc->name),
- st_upper (prefix), st_upper (sbc->prefix),
- st_upper (spec->varname));
- }
-
-
- if (s->valtype == VT_PAREN)
- {
- if (s->optvalue)
- {
- dump (1, "if (lex_match (lexer, T_LPAREN))");
- dump (1, "{");
- }
- else
- {
- dump (1, "if (!lex_match (lexer, T_LPAREN))");
- dump (1, "{");
- dump (0, "lex_error_expecting (lexer, \"`('\");");
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
- }
-
- if (s->value == VAL_INT)
- {
- dump (1, "if (!lex_force_int (lexer))");
- dump (0, "goto lossage;");
- dump (-1, "p->%s%s = lex_integer (lexer);",
- sbc->prefix, st_lower (s->valname));
- }
- else if (s->value == VAL_DBL)
- {
- dump (1, "if (!lex_force_num (lexer))");
- dump (0, "goto lossage;");
- dump (-1, "p->%s%s = lex_tokval (lexer);", sbc->prefix,
- st_lower (s->valname));
- }
- else if (s->value == VAL_STRING)
- {
- dump (1, "if (!lex_force_string_or_id (lexer))");
- dump (0, "goto lossage;");
- dump (-1, "free (p->%s%s);", sbc->prefix, st_lower (s->valname));
- dump (0, "p->%s%s = ss_xstrdup (ss_tokss (lexer));",
- sbc->prefix, st_lower (s->valname));
- }
- else
- abort ();
-
- if (s->restriction)
- {
- {
- char *str, *str2;
- str = xmalloc (MAX_TOK_LEN);
- str2 = xmalloc (MAX_TOK_LEN);
- sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
- sprintf (str, s->restriction, str2, str2, str2, str2,
- str2, str2, str2, str2);
- dump (1, "if (!(%s))", str);
- free (str);
- free (str2);
- }
-
- dump (1, "{");
- dump (0, "lex_error (lexer, NULL);");
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
-
- dump (0, "lex_get (lexer);");
-
- if (s->valtype == VT_PAREN)
- {
- dump (1, "if (!lex_force_match (lexer, T_RPAREN))");
- dump (0, "goto lossage;");
- outdent ();
- if (s->optvalue)
- {
- dump (-1, "}");
- outdent ();
- }
- }
-
- if (s != spec->omit_kw)
- dump (-1, "}");
- }
-
- if (s == spec->omit_kw)
- {
- dump (-1, "}");
- outdent ();
- }
- outdent ();
- }
-}
-
-/* Write out the code to parse subcommand SBC. */
-static void
-dump_subcommand (const subcommand *sbc)
-{
- if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
- {
- int count;
-
- dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
- dump (1, "{");
-
- {
- specifier *spec;
-
- for (count = 0, spec = sbc->spec; spec; spec = spec->next)
- {
- if (spec->s)
- dump_specifier_parse (spec, sbc);
- else
- {
- count++;
- dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
- make_match (st_upper (spec->varname)));
- if (sbc->type == SBC_PLAIN)
- dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
- spec->varname);
- else
- dump (0, "p->a_%s[%s%s%s] = 1;",
- st_lower (sbc->name),
- st_upper (prefix), st_upper (sbc->prefix),
- st_upper (spec->varname));
- outdent ();
- }
- }
- }
-
- {
- specifier *spec;
- setting *s;
-
- /* This code first finds the last specifier in sbc. Then it
- finds the last setting within that last specifier. Either
- or both might be NULL. */
- spec = sbc->spec;
- s = NULL;
- if (spec)
- {
- while (spec->next)
- spec = spec->next;
- s = spec->s;
- if (s)
- while (s->next)
- s = s->next;
- }
-
- if (spec && (!spec->s || !spec->omit_kw))
- {
- dump (1, "else");
- dump (1, "{");
- dump (0, "lex_error (lexer, NULL);");
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
- }
-
- dump (0, "lex_match (lexer, T_COMMA);");
- dump (-1, "}");
- outdent ();
- }
- else if (sbc->type == SBC_VARLIST)
- {
- dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
- "PV_APPEND%s%s))",
- st_lower (sbc->prefix), st_lower (sbc->name),
- st_lower (sbc->prefix), st_lower (sbc->name),
- sbc->pv_options ? " |" : "",
- sbc->pv_options ? sbc->pv_options : "");
- dump (0, "goto lossage;");
- outdent ();
- }
- else if (sbc->type == SBC_VAR)
- {
- dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
- st_lower (sbc->prefix), st_lower (sbc->name));
- dump (1, "if (!p->%sv_%s)",
- st_lower (sbc->prefix), st_lower (sbc->name));
- dump (0, "goto lossage;");
- outdent ();
- }
- else if (sbc->type == SBC_STRING)
- {
- dump (1, "if (!lex_force_string (lexer))");
- dump (0, "return false;");
- outdent ();
- dump (0, "free(p->s_%s);", st_lower(sbc->name));
- dump (0, "p->s_%s = ss_xstrdup (lex_tokss (lexer));",
- st_lower (sbc->name));
- dump (0, "lex_get (lexer);");
- }
- else if (sbc->type == SBC_DBL)
- {
- dump (1, "if (!lex_force_num (lexer))");
- dump (0, "goto lossage;");
- dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
- st_lower (sbc->name), st_lower (sbc->name));
- dump (0, "lex_get(lexer);");
- }
- else if (sbc->type == SBC_INT)
- {
- dump(1, "{");
- dump(0, "int x;");
- dump (1, "if (!lex_force_int (lexer))");
- dump (0, "goto lossage;");
- dump (-1, "x = lex_integer (lexer);");
- dump (0, "lex_get(lexer);");
- dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name));
- dump (-1,"}");
- }
- else if (sbc->type == SBC_PINT)
- {
- dump (0, "lex_match (lexer, T_LPAREN);");
- dump (1, "if (!lex_force_int (lexer))");
- dump (0, "goto lossage;");
- dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
- dump (0, "lex_match (lexer, T_RPAREN);");
- }
- else if (sbc->type == SBC_DBL_LIST || sbc->type == SBC_INT_LIST)
- {
- dump (0, "if (p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
- dump (1, "{");
- dump (0, "subc_list_error (lexer, \"%s\", MAXLISTS);",
- st_lower(sbc->name));
- dump (0, "goto lossage;");
- dump (-1,"}");
-
- dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
- dump (1, "{");
- dump (0, "lex_match (lexer, T_COMMA);");
- dump (0, "if (!lex_force_num (lexer))");
- dump (1, "{");
- dump (0, "goto lossage;");
- dump (-1,"}");
-
- dump (0, "subc_list_%s_push (&p->%cl_%s[p->sbc_%s-1], lex_number (lexer));",
- sbc->type == SBC_INT_LIST ? "int" : "double",
- sbc->type == SBC_INT_LIST ? 'i' : 'd',
- st_lower (sbc->name), st_lower (sbc->name));
-
- dump (0, "lex_get (lexer);");
- dump (-1,"}");
-
- }
- else if (sbc->type == SBC_CUSTOM)
- {
- dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
- st_lower (prefix), st_lower (sbc->name));
- dump (0, "{");
- dump (1, "case 0:");
- dump (0, "goto lossage;");
- dump (-1, "case 1:");
- indent ();
- dump (0, "break;");
- dump (-1, "case 2:");
- indent ();
- dump (0, "lex_error (lexer, NULL);");
- dump (0, "goto lossage;");
- dump (-1, "default:");
- indent ();
- dump (0, "NOT_REACHED ();");
- dump (-1, "}");
- outdent ();
- }
-}
-
-/* Write out entire parser. */
-static void
-dump_parser (int persistent)
-{
- int f;
-
- indent = 0;
-
- dump (0, "static int");
- dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
- make_identifier (cmdname),
- (def && (def->type == SBC_VARLIST || def->type == SBC_CUSTOM))?"":" UNUSED",
- make_identifier (cmdname));
- dump (1, "{");
-
- dump_vars_init (persistent);
-
- dump (1, "for (;;)");
- dump (1, "{");
-
- f = 0;
- if (def && (def->type == SBC_VARLIST))
- {
- if (def->type == SBC_VARLIST)
- dump (1, "if (lex_token (lexer) == T_ID "
- "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) != NULL "
- "&& lex_next_token (lexer, 1) != T_EQUALS)");
- else
- {
- dump (0, "if ((lex_token (lexer) == T_ID "
- "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) "
- "&& lex_next_token (lexer, 1) != T_EQUALS)");
- dump (1, " || token == T_ALL)");
- }
- dump (1, "{");
- dump (0, "p->sbc_%s++;", st_lower (def->name));
- dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
- "PV_APPEND))",
- st_lower (def->prefix), st_lower (def->name),
- st_lower (def->prefix), st_lower (def->name));
- dump (0, "goto lossage;");
- dump (-2, "}");
- outdent ();
- f = 1;
- }
- else if (def && def->type == SBC_CUSTOM)
- {
- dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
- st_lower (prefix), st_lower (def->name));
- dump (0, "{");
- dump (1, "case 0:");
- dump (0, "goto lossage;");
- dump (-1, "case 1:");
- indent ();
- dump (0, "p->sbc_%s++;", st_lower (def->name));
- dump (0, "continue;");
- dump (-1, "case 2:");
- indent ();
- dump (0, "break;");
- dump (-1, "default:");
- indent ();
- dump (0, "NOT_REACHED ();");
- dump (-1, "}");
- outdent ();
- }
-
- {
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
- f = 1;
- dump (1, "{");
-
- dump (0, "lex_match (lexer, T_EQUALS);");
- dump (0, "p->sbc_%s++;", st_lower (sbc->name));
- if (sbc->arity != ARITY_MANY)
- {
- dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
- dump (1, "{");
- dump (0, "lex_sbc_only_once (\"%s\");", sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
- dump_subcommand (sbc);
- dump (-1, "}");
- outdent ();
- }
- }
-
-
- /* Now deal with the /ALGORITHM subcommand implicit to all commands */
- dump(1,"else if (settings_get_syntax () != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
- dump(1,"{");
-
- dump (0, "lex_match (lexer, T_EQUALS);");
-
- dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
- dump(0,"settings_set_cmd_algorithm (COMPATIBLE);");
- outdent();
- dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
- dump(0,"settings_set_cmd_algorithm (ENHANCED);");
-
- dump (-1, "}");
- outdent ();
-
-
-
- dump (1, "if (!lex_match (lexer, T_SLASH))");
- dump (0, "break;");
- dump (-2, "}");
- outdent ();
- dump_blank_line (0);
- dump (1, "if (lex_token (lexer) != T_ENDCMD)");
- dump (1, "{");
- dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
- dump (0, "goto lossage;");
- dump (-1, "}");
- dump_blank_line (0);
-
- outdent ();
-
- {
- /* Check that mandatory subcommands have been specified */
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
-
- if (sbc->arity == ARITY_ONCE_EXACTLY)
- {
- dump (0, "if (0 == p->sbc_%s)", st_lower (sbc->name));
- dump (1, "{");
- dump (0, "lex_sbc_missing (\"%s\");", sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- dump_blank_line (0);
- }
- }
- }
-
- dump (-1, "return true;");
- dump_blank_line (0);
- dump (-1, "lossage:");
- indent ();
- dump (0, "free_%s (p);", make_identifier (cmdname));
- dump (0, "return false;");
- dump (-1, "}");
- dump_blank_line (0);
-}
-
-
-/* Write the output file header. */
-static void
-dump_header (void)
-{
- indent = 0;
- dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
- dump_blank_line (0);
- dump (0, " Generated by q2c from %s.", ifn);
- dump (0, " Do not modify!");
- dump (0, " */");
-}
-
-/* Write out commands to free variable state. */
-static void
-dump_free (int persistent)
-{
- subcommand *sbc;
- int used;
-
- indent = 0;
-
- used = 0;
- if (! persistent)
- {
- for (sbc = subcommands; sbc; sbc = sbc->next)
- used = (sbc->type == SBC_STRING
- || sbc->type == SBC_DBL_LIST
- || sbc->type == SBC_INT_LIST);
- }
-
- dump (0, "static void");
- dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
- make_identifier (cmdname), used ? "" : " UNUSED");
- dump (1, "{");
-
- if (! persistent)
- {
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- switch (sbc->type)
- {
- case SBC_VARLIST:
- dump (0, "free (p->v_%s);", st_lower (sbc->name));
- break;
- case SBC_STRING:
- dump (0, "free (p->s_%s);", st_lower (sbc->name));
- break;
- case SBC_DBL_LIST:
- case SBC_INT_LIST:
- dump (0, "{");
- dump (1, "int i;");
- dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
- dump (1, "subc_list_%s_destroy(&p->%cl_%s[i]);",
- sbc->type == SBC_INT_LIST ? "int" : "double",
- sbc->type == SBC_INT_LIST ? 'i' : 'd',
- st_lower (sbc->name));
- dump (0, "}");
- outdent();
- break;
- case SBC_PLAIN:
- {
- specifier *spec;
- setting *s;
-
- for (spec = sbc->spec; spec; spec = spec->next)
- for (s = spec->s; s; s = s->next)
- if (s->value == VAL_STRING)
- dump (0, "free (p->%s%s);",
- sbc->prefix, st_lower (s->valname));
- }
- default:
- break;
- }
- }
- }
-
- dump (-1, "}");
-
-}
-
-
-
-/* Returns the name of a directive found on the current input line, if
- any, or a null pointer if none found. */
-static const char *
-recognize_directive (void)
-{
- static char directive[16];
- char *sp, *ep;
-
- sp = skip_ws (buf);
- if (strncmp (sp, "/*", 2))
- return NULL;
- sp = skip_ws (sp + 2);
- if (*sp != '(')
- return NULL;
- sp++;
-
- ep = strchr (sp, ')');
- if (ep == NULL)
- return NULL;
-
- if (ep - sp > 15)
- ep = sp + 15;
- memcpy (directive, sp, ep - sp);
- directive[ep - sp] = '\0';
- return directive;
-}
-
-int
-main (int argc, char *argv[])
-{
- program_name = argv[0];
- if (argc != 3)
- fail ("Syntax: q2c input.q output.c");
-
- ifn = argv[1];
- in = fopen (ifn, "r");
- if (!in)
- fail ("%s: open: %s.", ifn, strerror (errno));
-
- ofn = argv[2];
- out = fopen (ofn, "w");
- if (!out)
- fail ("%s: open: %s.", ofn, strerror (errno));
-
- is_open = true;
- buf = xmalloc (MAX_LINE_LEN);
- tokstr = xmalloc (MAX_TOK_LEN);
-
- dump_header ();
-
-
- indent = 0;
- dump (0, "#line %d \"%s\"", ln + 1, ifn);
- while (get_line ())
- {
- const char *directive = recognize_directive ();
- if (directive == NULL)
- {
- dump (0, "%s", buf);
- continue;
- }
-
- dump (0, "#line %d \"%s\"", oln + 1, ofn);
- if (!strcmp (directive, "specification"))
- {
- /* Skip leading slash-star line. */
- get_line ();
- lex_get ();
-
- parse ();
-
- /* Skip trailing star-slash line. */
- get_line ();
- }
- else if (!strcmp (directive, "headers"))
- {
- indent = 0;
-
- dump (0, "#include <stdlib.h>");
- dump_blank_line (0);
-
- dump (0, "#include \"data/settings.h\"");
- dump (0, "#include \"data/variable.h\"");
- dump (0, "#include \"language/lexer/lexer.h\"");
- dump (0, "#include \"language/lexer/subcommand-list.h\"");
- dump (0, "#include \"language/lexer/variable-parser.h\"");
- dump (0, "#include \"libpspp/assertion.h\"");
- dump (0, "#include \"libpspp/cast.h\"");
- dump (0, "#include \"libpspp/message.h\"");
- dump (0, "#include \"libpspp/str.h\"");
- dump_blank_line (0);
-
- dump (0, "#include \"gl/xalloc.h\"");
- dump_blank_line (0);
- }
- else if (!strcmp (directive, "declarations"))
- dump_declarations ();
- else if (!strcmp (directive, "functions"))
- {
- dump_parser (0);
- dump_free (0);
- }
- else if (!strcmp (directive, "_functions"))
- {
- dump_parser (1);
- dump_free (1);
- }
- else
- error ("unknown directive `%s'", directive);
- indent = 0;
- dump (0, "#line %d \"%s\"", ln + 1, ifn);
- }
-
- return EXIT_SUCCESS;
-}
projects / pspp / commitdiff