From: Ben Pfaff Date: Sun, 21 Mar 2021 19:03:52 +0000 (-0700) Subject: q2c: Remove, since it is no longer used. X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?p=pspp;a=commitdiff_plain;h=0a18cc59b123294641d8e2bafc3d579be1f59e77 q2c: Remove, since it is no longer used. This was the only tool that needed the build system's C compiler, so also remove the parts of the build system that supported that. --- diff --git a/Makefile.am b/Makefile.am index 5d020c65db..9254dd8b68 100644 --- a/Makefile.am +++ b/Makefile.am @@ -37,13 +37,6 @@ AM_CFLAGS+=-Wall -Wextra -Wwrite-strings -Wstrict-prototypes \ -Wpointer-arith -Wno-sign-compare -Wmissing-prototypes endif -.q.c: - @$(MKDIR_P) `dirname $@` - $(AM_V_GEN)./src/language/lexer/q2c$(EXEEXT_FOR_BUILD) $< $@ - -$(all_q_sources:.q=.c): src/language/lexer/q2c$(EXEEXT_FOR_BUILD) -all_q_sources = - pkgsysconfdir = $(sysconfdir)/$(PACKAGE) @@ -64,7 +57,7 @@ DIST_HOOKS = INSTALL_DATA_HOOKS = UNINSTALL_DATA_HOOKS = PHONY = -SUFFIXES = .q +SUFFIXES = LDADD = gl/libgl.la gl/libgl.la: config.h diff --git a/acinclude.m4 b/acinclude.m4 index 5e393144f4..c1c67119aa 100644 --- a/acinclude.m4 +++ b/acinclude.m4 @@ -139,40 +139,6 @@ AC_DEFUN([PSPP_READLINE], AC_SUBST(LTLIBREADLINE) ]) -dnl Check for build tools. Adapted from bfd library. - -AC_DEFUN([PSPP_CC_FOR_BUILD], -[# Put a plausible default for CC_FOR_BUILD in Makefile. -if test -z "$CC_FOR_BUILD"; then - if test "x$cross_compiling" = "xno"; then - CC_FOR_BUILD='$(CC)' - else - CC_FOR_BUILD=cc - fi -fi -AC_SUBST(CC_FOR_BUILD) -# Also set EXEEXT_FOR_BUILD. -if test "x$cross_compiling" = "xno"; then - EXEEXT_FOR_BUILD='$(EXEEXT)' -else - AC_CACHE_CHECK([for build system executable suffix], pspp_cv_build_exeext, - [rm -f conftest* - echo 'int main () { return 0; }' > conftest.c - pspp_cv_build_exeext= - ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 - for file in conftest.*; do - case $file in # ( - *.c | *.o | *.obj | *.ilk | *.pdb) ;; # ( - *) pspp_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; - esac - done - rm -f conftest* - test x"${pspp_cv_build_exeext}" = x && pspp_cv_build_exeext=no]) - EXEEXT_FOR_BUILD="" - test x"${pspp_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${pspp_cv_build_exeext} -fi -AC_SUBST(EXEEXT_FOR_BUILD)]) - dnl Check for LC_PAPER, _NL_PAPER_WIDTH, _NL_PAPER_HEIGHT. AC_DEFUN([PSPP_LC_PAPER], [AC_CACHE_CHECK(for LC_PAPER, pspp_cv_lc_paper, [ diff --git a/configure.ac b/configure.ac index 76e5cf01e7..6d1b3bbc99 100644 --- a/configure.ac +++ b/configure.ac @@ -49,7 +49,6 @@ PSPP_ENABLE_WERROR AM_CONDITIONAL(cc_is_gcc, test x"$GCC" = x"yes" ) -PSPP_CC_FOR_BUILD PSPP_PERL PSPP_PYTHON AC_CHECK_PROGS([TEX], [tex], [no]) diff --git a/doc/automake.mk b/doc/automake.mk index def0dbf395..c38de5535c 100644 --- a/doc/automake.mk +++ b/doc/automake.mk @@ -61,8 +61,7 @@ doc_pspp_dev_TEXINFOS = doc/version-dev.texi \ doc/dev/portable-file-format.texi \ doc/dev/spv-file-format.texi \ doc/dev/tlo-file-format.texi \ - doc/dev/encrypted-file-wrappers.texi \ - doc/dev/q2c.texi + doc/dev/encrypted-file-wrappers.texi dist_man_MANS += doc/pspp.1 \ doc/psppire.1 diff --git a/doc/dev/q2c.texi b/doc/dev/q2c.texi deleted file mode 100644 index 70c286a029..0000000000 --- a/doc/dev/q2c.texi +++ /dev/null @@ -1,299 +0,0 @@ -@c PSPP - a program for statistical analysis. -@c Copyright (C) 2019 Free Software Foundation, Inc. -@c Permission is granted to copy, distribute and/or modify this document -@c under the terms of the GNU Free Documentation License, Version 1.3 -@c or any later version published by the Free Software Foundation; -@c with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. -@c A copy of the license is included in the section entitled "GNU -@c Free Documentation License". -@c - -@node q2c Input Format -@appendix @code{q2c} Input Format - -PSPP statistical procedures have a bizarre and somewhat irregular -syntax. Despite this, a parser generator has been written that -adequately addresses many of the possibilities and tries to provide -hooks for the exceptional cases. This parser generator is named -@code{q2c}. - -@menu -* Invoking q2c:: q2c command-line syntax. -* q2c Input Structure:: High-level layout of the input file. -* Grammar Rules:: Syntax of the grammar rules. -@end menu - -@node Invoking q2c -@section Invoking q2c - -@example -q2c @var{input.q} @var{output.c} -@end example - -@code{q2c} translates a @samp{.q} file into a @samp{.c} file. It takes -exactly two command-line arguments, which are the input file name and -output file name, respectively. @code{q2c} does not accept any -command-line options. - -@node q2c Input Structure -@section @code{q2c} Input Structure - -@code{q2c} input files are divided into two sections: the grammar rules -and the supporting code. The @dfn{grammar rules}, which make up the -first part of the input, are used to define the syntax of the -statistical procedure to be parsed. The @dfn{supporting code}, -following the grammar rules, are copied largely unchanged to the output -file, except for certain escapes. - -The most important lines in the grammar rules are used for defining -procedure syntax. These lines can be prefixed with a dollar sign -(@samp{$}), which prevents Emacs' CC-mode from munging them. Besides -this, a bang (@samp{!}) at the beginning of a line causes the line, -minus the bang, to be written verbatim to the output file (useful for -comments). As a third special case, any line that begins with the exact -characters @code{/* *INDENT} is ignored and not written to the output. -This allows @code{.q} files to be processed through @code{indent} -without being munged. - -The syntax of the grammar rules themselves is given in the following -sections. - -The supporting code is passed into the output file largely unchanged. -However, the following escapes are supported. Each escape must appear -on a line by itself. - -@table @code -@item /* (header) */ - -Expands to a series of C @code{#include} directives which include the -headers that are required for the parser generated by @code{q2c}. - -@item /* (decls @var{scope}) */ - -Expands to C variable and data type declarations for the variables and -@code{enum}s input and output by the @code{q2c} parser. @var{scope} -must be either @code{local} or @code{global}. @code{local} causes the -declarations to be output as function locals. @code{global} causes them -to be declared as @code{static} module variables; thus, @code{global} is -a bit of a misnomer. - -@item /* (parser) */ - -Expands to the entire parser. Must be enclosed within a C function. - -@item /* (free) */ - -Expands to a set of calls to the @code{free} function for variables -declared by the parser. Only needs to be invoked if subcommands of type -@code{string} are used in the grammar rules. -@end table - -@node Grammar Rules -@section Grammar Rules - -The grammar rules describe the format of the syntax that the parser -generated by @code{q2c} will understand. The way that the grammar rules -are included in @code{q2c} input file are described above. - -The grammar rules are divided into tokens of the following types: - -@table @asis -@item Identifier (@code{ID}) - -An identifier token is a sequence of letters, digits, and underscores -(@samp{_}). Identifiers are @emph{not} case-sensitive. - -@item String (@code{STRING}) - -String tokens are initiated by a double-quote character (@samp{"}) and -consist of all the characters between that double quote and the next -double quote, which must be on the same line as the first. Within a -string, a backslash can be used as a ``literal escape''. The only -reasons to use a literal escape are to include a double quote or a -backslash within a string. - -@item Special character - -Other characters, other than white space, constitute tokens in -themselves. - -@end table - -The syntax of the grammar rules is as follows: - -@example -grammar-rules ::= command-name opt-prefix : subcommands . -command-name ::= ID - ::= STRING -opt-prefix ::= - ::= ( ID ) -subcommands ::= subcommand - ::= subcommands ; subcommand -@end example - -The syntax begins with an ID token that gives the name of the -procedure to be parsed. For command names that contain multiple -words, a STRING token may be used instead, e.g.@: @samp{"FILE -HANDLE"}. Optionally, an ID in parentheses specifies a prefix used -for all file-scope identifiers declared by the emitted code. - -The rest of the syntax consists of subcommands separated by semicolons -(@samp{;}) and terminated with a full stop (@samp{.}). - -@example -subcommand ::= default-opt arity-opt ID sbc-defn -default-opt ::= - ::= * -arity-opt ::= - ::= + - ::= ^ -sbc-defn ::= opt-prefix = specifiers - ::= [ ID ] = array-sbc - ::= opt-prefix = sbc-special-form -@end example - -A subcommand that begins with an asterisk (@samp{*}) is the default -subcommand. The keyword used for the default subcommand can be omitted -in the PSPP syntax file. - -A plus sign (@samp{+}) indicates that a subcommand can appear more than -once. A caret (@samp{^}) indicate that a subcommand must appear exactly -once. A subcommand marked with neither character may appear once or not -at all, but not more than once. - -The subcommand name appears after the leading option characters. - -There are three forms of subcommands. The first and most common form -simply gives an equals sign (@samp{=}) and a list of specifiers, which -can each be set to a single setting. The second form declares an array, -which is a set of flags that can be individually turned on by the user. -There are also several special forms that do not take a list of -specifiers. - -Arrays require an additional @code{ID} argument. This is used as a -prefix, prepended to the variable names constructed from the -specifiers. The other forms also allow an optional prefix to be -specified. - -@example -array-sbc ::= alternatives - ::= array-sbc , alternatives -alternatives ::= ID - ::= alternatives | ID -@end example - -An array subcommand is a set of Boolean values that can independently be -turned on by the user, listed separated by commas (@samp{,}). If an value has more -than one name then these names are separated by pipes (@samp{|}). - -@example -specifiers ::= specifier - ::= specifiers , specifier -specifier ::= opt-id : settings -opt-id ::= - ::= ID -@end example - -Ordinary subcommands (other than arrays and special forms) require a -list of specifiers. Each specifier has an optional name and a list of -settings. If the name is given then a correspondingly named variable -will be used to store the user's choice of setting. If no name is given -then there is no way to tell which setting the user picked; in this case -the settings should probably have values attached. - -@example -settings ::= setting - ::= settings / setting -setting ::= setting-options ID setting-value -setting-options ::= - ::= * - ::= ! - ::= * ! -@end example - -Individual settings are separated by forward slashes (@samp{/}). Each -setting can be as little as an @code{ID} token, but options and values -can optionally be included. The @samp{*} option means that, for this -setting, the @code{ID} can be omitted. The @samp{!} option means that -this option is the default for its specifier. - -@example -setting-value ::= - ::= ( setting-value-2 ) - ::= setting-value-2 -setting-value-2 ::= setting-value-options setting-value-type : ID -setting-value-options ::= - ::= * -setting-value-type ::= N - ::= D - ::= S -@end example - -Settings may have values. If the value must be enclosed in parentheses, -then enclose the value declaration in parentheses. Declare the setting -type as @samp{n}, @samp{d}, or @samp{s} for integer, floating-point, -or string type, respectively. The given @code{ID} is used to -construct a variable name. -If option @samp{*} is given, then the value is optional; otherwise it -must be specified whenever the corresponding setting is specified. - -@example -sbc-special-form ::= VAR - ::= VARLIST varlist-options - ::= INTEGER opt-list - ::= DOUBLE opt-list - ::= PINT - ::= STRING @r{(the literal word STRING)} - ::= CUSTOM -varlist-options ::= - ::= ( STRING ) -opt-list ::= - ::= LIST -@end example - -The special forms are of the following types: - -@table @code -@item VAR - -A single variable name. - -@item VARLIST - -A list of variables. If given, the string can be used to provide -@code{PV_@var{*}} options to the call to @code{parse_variables}. - -@item INTEGER - -A single integer value. - -@item INTEGER LIST - -A list of integers separated by spaces or commas. - -@item DOUBLE - -A single floating-point value. - -@item DOUBLE LIST - -A list of floating-point values. - -@item PINT - -A single positive integer value. - -@item STRING - -A string value. - -@item CUSTOM - -A custom function is used to parse this subcommand. The function must -have prototype @code{int custom_@var{name} (void)}. It should return 0 -on failure (when it has already issued an appropriate diagnostic), 1 on -success, or 2 if it fails and the calling function should issue a syntax -error on behalf of the custom handler. - -@end table -@setfilename ignored diff --git a/doc/pspp-dev.texi b/doc/pspp-dev.texi index a9d00a9c22..846d5f4c46 100644 --- a/doc/pspp-dev.texi +++ b/doc/pspp-dev.texi @@ -97,7 +97,6 @@ Free Documentation License". * SPSS Viewer File Format:: Format of SPSS Viewer (SPV) files. * SPSS TableLook File Formats:: Formats of .stt and .tlo files. * Encrypted File Wrappers:: Common wrapper for encrypted SPSS files. -* q2c Input Format:: Format of syntax accepted by q2c. * GNU Free Documentation License:: License for copying this manual. @end menu @@ -119,7 +118,6 @@ Free Documentation License". @include dev/spv-file-format.texi @include dev/tlo-file-format.texi @include dev/encrypted-file-wrappers.texi -@include dev/q2c.texi @include fdl.texi diff --git a/src/language/lexer/automake.mk b/src/language/lexer/automake.mk index a19eba686a..3eb23eb424 100644 --- a/src/language/lexer/automake.mk +++ b/src/language/lexer/automake.mk @@ -38,13 +38,3 @@ language_lexer_sources = \ src/language/lexer/value-parser.h \ src/language/lexer/variable-parser.c \ src/language/lexer/variable-parser.h - -EXTRA_DIST += src/language/lexer/q2c.c - - -src/language/lexer/q2c$(EXEEXT_FOR_BUILD): $(top_srcdir)/src/language/lexer/q2c.c - @$(MKDIR_P) `dirname $@` - $(AM_V_GEN)$(CC_FOR_BUILD) $(top_srcdir)/src/language/lexer/q2c.c -o $(top_builddir)/src/language/lexer/q2c$(EXEEXT_FOR_BUILD) - - -CLEANFILES += src/language/lexer/q2c$(EXEEXT_FOR_BUILD) diff --git a/src/language/lexer/q2c.c b/src/language/lexer/q2c.c deleted file mode 100644 index 28099d1635..0000000000 --- a/src/language/lexer/q2c.c +++ /dev/null @@ -1,2071 +0,0 @@ -/* 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 . */ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -/* 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; - -/* 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; -} - -/* 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 (); -} - -/* 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; - -/* 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; - } -} - -/* 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 "); - 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; -}